hallo und guten morgen,
ich nutze den folgenden code zum kopieren von einzelnen zeilen, wenn die bedingung erfüllt ist.
nun möchte ich das in der zieltabelle die zeilenhöhe automatisch erhöht wird (z.b auf „22“).
kann man das in den code einbauen und kann mir jemand helfen?
gruß und danke
jürgen
Option Explicit
Public Sub kopieren()
Dim WkSh_Q As Worksheet
Dim WkSh_Z As Worksheet
Dim rZelle As Range
Dim sFundst As String
Dim sSuchbegriff As String
Dim lZeile_Z As Long
sSuchbegriff = „Test“ ’ der zu suchende Begriff
lZeile_Z = 3 ’ die erste Ausgabezeile -1
Application.ScreenUpdating = False
Set WkSh_Q = Worksheets(„alle“) ’ den Tabellenblattnamen ggf. anpassen !!!
Set WkSh_Z = Worksheets(„name1“) ’ den Tabellenblattnamen ggf. anpassen !!!
With WkSh_Q.Columns(4)
’ wenn der gesamte Suchbegriff gefunden werden soll muss es
’ xlWhole anstelle von xlPart heißen.
Set rZelle = .Find(sSuchbegriff, LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
lZeile_Z = lZeile_Z + 1
WkSh_Q.Rows(rZelle.Row).Copy Destination:=WkSh_Z.Rows(lZeile_Z)
Set rZelle = .FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address sFundst
Else
MsgBox „Zum gesuchen Begriff „““ & sSuchbegriff & _
„“" wurde kein Eintrag gefunden.", _
48, " Hinweis für " & Application.UserName
End If
End With
Application.ScreenUpdating = True
End Sub
ich nutze den folgenden code zum kopieren von einzelnen
zeilen, wenn die bedingung erfüllt ist.
nun möchte ich das in der zieltabelle die zeilenhöhe
automatisch erhöht wird (z.b auf „22“).
kann man das in den code einbauen und kann mir jemand helfen?
Remoin Jürgen,
baue nach der Zeile:
WkSh_Q.Rows(rZelle.Row).Copy Destination:=WkSh_Z.Rows(lZeile_Z)
die folgende Codezeile ein:
WkSh_Z.Rows(lZeile_Z).RowHeight = 22
Gruß
Reinhard
hallo reinhard,
danke erst einmal für die schnelle antwort und deine hilfe, funktioniert tadellos.
könntest du mir bei dem folgenden problem auch helfen?
diesen code habe ich in dem sheet „alle“ stehen, sobald ich die mappe aber schütze, funktioniert nichts mehr.
außerdem kann man die cases so einstellen, dass sich die farbe auch ändert wenn man einen anderen namen einträgt ohne noch mehr case anweisungen hinzu zu fügen.
für hilfe wäre ich dankbar
gruß
jürgen
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [d4:d130]) Is Nothing Then Exit Sub
With Target
Select Case .Value
Case „name1“
.Interior.ColorIndex = 5
Case „name2“
.Interior.ColorIndex = 6
Case „name3“
.Interior.ColorIndex = 22
Case „name4“
.Interior.ColorIndex = 18
Case Else
.Interior.ColorIndex = xlNone
End Select
End With
End Sub
Hallo Jürgen,
diesen code habe ich in dem sheet „alle“ stehen, sobald ich
die mappe aber schütze, funktioniert nichts mehr.
dann mußt du zum Anfang des Codes einfügen sowas wie
Activesheet.unprotect
und am Ende
Activesheet.protect
Lies in der Hilfe nach da steht bei protect/unprotect wie du da ein Passwort einbaust.
außerdem kann man die cases so einstellen, dass sich die farbe
auch ändert wenn man einen anderen namen einträgt ohne noch
mehr case anweisungen hinzu zu fügen.
? Sorry, verstehe ich nicht.
Mit Case xyz gibst du vor was passieren soll wenn der Wert so ist.
Alles was bei den einzelnen Cases nicht zutrifft das wird im Case Else Zweig "„behandelt“
Gruß
Reinhard
hallo reinhard,
jetzt klappt alles einwandfrei.
gruß und danke nochmal
jürgen