Kopierenmakro
stefan
das Kopieremakro hier ist Super danke euch. Eine sache habe da ich noch wenn ausgeführt
entstehen leer zeilen ich würde also gern erreichen das die Datensätz wieder untereinander stehen ohne die zwischenräume ist das möglich. Danke schon mal :)
Private Sub CommandButton1_Click()
Dim a As Long, b As Long, i As Long
Application.ScreenUpdating = False
'Startzeilen ermitteln
With Worksheets("Tabelle2")
If IsEmpty(.UsedRange) Then
a = 1
Else
a = .Cells.SpecialCells(xlCellTypeLastCell).Row + 1
End If
End With
With Worksheets("Tabelle3")
If IsEmpty(.UsedRange) Then
b = 1
Else
b = .Cells.SpecialCells(xlCellTypeLastCell).Row + 1
End If
End With
With Worksheets("Tabelle1")
For i = 1 To 100
If .Cells(i, 2) = "+" Then
.Rows(i).Copy _
Destination:=Worksheets("Tabelle2").Rows(a)
a = a + 1
.Rows(i).ClearContents
Else
.Cells(i, 2) = "-"
.Rows(i).Copy _
Destination:=Worksheets("Tabelle3").Rows(b)
b = b + 1
.Rows(i).ClearContents
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Danke Danke