VBA - Code Optimierung
30.06.2013 13:26:28
Markus
ich habe mir mit meinen bescheidenen VBA Kenntnissen und den vielen hilfreichen Beiträgen aus dem Forum den folgenden Code zusammen gebastelt. Leider habe ich noch ein Problem mit der ersten With-Anweisung. Ansonsten Funktioniert der Code soweit wie er soll. Kann mir vielleicht jemand den Code vereinfachen bzw. optimieren?
Vielen Dank schon mal an alle.
Gruß Markus
Sub kopieren()
With Sheets("Test")
Range("A2:B5000").Select 'Löscht die Einträge von Datenblatt "Overview", soll so _
aber nicht sein, nur bei Blatt "Test" soll das sein, vielleicht kann man das auch dynamisch machen, ohne Range, nur alle gefüllten Zeilen
Selection.ClearContents
End With
With Sheets("Overview")
.Unprotect Password:="Test"
Dim z As Integer
Dim leer As Integer
Dim Target1 As Range
Dim Target2 As Range
z = 24
Do
If .Cells(z, 4) "" Then 'Makro soll so lange laufen bis in Spalte 4 kein Eintrag _
mehr ist
leer = False
Else
leer = True
End If
If .Cells(z, 3).Value = "a" Then 'Wenn in Spalte 3 ein "a" dann sollen der Inhalt aus _
Spalte 4 und 5 kopiert werden
.Cells(z, 4).Copy
.Cells(z, 5).Copy
' Der Inhalt aus Spalte 4 und 5 sollen in die nächste freie _
Zelle im Arbeitsblatt "Test" kopiert werden (Spalte 1 und 2)
Set Target1 = Sheets("Test").Range("A65536").End(xlUp).Offset(1, 0)
Sheets("Overview").Cells(z, 4).Copy Destination:=Target1
Set Target2 = Sheets("Test").Range("B65536").End(xlUp).Offset(1, 0)
Sheets("Overview").Cells(z, 5).Copy Destination:=Target2
End If
z = z + 1
Loop Until leer = True
End With
End Sub
Anzeige