Sub test()
For i = 1 To Cells(Rows.Count, 8).End(xlUp).Row
If Cells(i, 8).Value = "x" Then
Rows(i).Copy Destination:=Sheets("Tabelle2").Cells(Sheets("Tabelle2").Cells(Rows.Count, 1).End( _
xlUp).Row + 1, 1)
End If
Next
End Sub
Ich bin auch nicht so fitt, dass ich das Makro komplett umbauen könnte.
Gruß Jürgen
Rows(i).Copy Destination:=Sheets("Tabelle2").Cells(Sheets("Tabelle2").Cells(Rows.Count, 1)
.End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
:=False, Transpose:=False
bin aber auch Laie bei VBA, deswegen ohne Garantie.
Gruß
David
Sub test()
Dim i As Long, tLR As Long
Dim tarWks As Worksheet, srcWks As Worksheet
Set srcWks = Worksheets("Tabelle1")
Set tarWks = Worksheets("Tabelle2")
With srcWks
For i = 1 To .Cells(.Rows.Count, 10).End(xlUp).Row
If .Cells(i, 10).Value = "x" Then
tLR = tarWks.Cells(Rows.Count, 1).End(xlUp).Row + 1
Debug.Print tLR
With tarWks
.Range(.Cells(tLR, 1), .Cells(tLR, 10)).Value = srcWks.Range(srcWks.Cells(i, 1), _
srcWks.Cells(i, 10)).Value
End With
End If
Next i
End With
End Sub
Gruss Rainer
Sub kopieren()
With Sheets("Tabelle1").UsedRange
.AutoFilter Field:=10, Criteria1:="x"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
End With
Sheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Sheets("Tabelle1").UsedRange.AutoFilter
End Sub
allerdings sollte die erste Zeile in Tabelle1 eine Überschriftenzeile sein.
Gruß, Daniel