Private Sub CommandButton1_Click()
Dim wbk As Workbook
Dim wsQ As Worksheet
Dim wsZ As Worksheet
Dim arrRange As Range
Dim intRow As Integer
Dim LastRow As Integer
Set wbk = ThisWorkbook
Set wsQ = ThisWorkbook.Worksheets("SITE FM")
Set wsZ = ThisWorkbook.Worksheets("Zieltabelle")
Application.ScreenUpdating = False
wsQ.Range("A1:AA1").Copy Destination:=wsZ.Range("A1:AA1")
For intRow = 1 To wsQ.UsedRange.Rows.Count
If wsQ.Cells(intRow, 27).Text = "x" Then
wsQ.Range("A2:Z" & intRow).Copy
With wsZ
.Range("A" & Cells(.Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
End If
Next intRow
Application.ScreenUpdating = True
End Sub
Ich wäre über jede Hilfe dankbar!
Liebe Grüße und vielen Dank schon im Voraus :-)