Hallo Zusammen, 

ich hoffe, ihr könnt mir bei einem Problem mit meinem VBA-Code helfen, welches meine (limitierten) Fähigkeiten übersteigt:

Mit folgendem Code möchte ich einen Zellbereich von Spalte A bis Z von Zeile 2 bis zur letztgenutzten Zeile kopieren und in ein anderes Tabellenblatt kopieren.

Dabei soll bei jeder Zeile die Bedingung erfüllt sein, dass in Spalte AA durch eine dort bereits hinterlegte Formel ein "x" steht, damit die Zeile kopiert wird. Falls das Ergebnis dieser WENN-Formel leer ist (kein x), dann soll diese Zeile übersprungen und nicht in das Zeilarbeitsblatt kopiert werden.

Das kopieren des Bereichs funktioniert soweit auch gut, nur leider werden alle Zeilen, unabhängig davon, ob in Spalte AA ein x steht oder nicht, kopiert.

Habt ihr vielleicht eine Idee, wie ich den Code anpassen muss, um diese Zeilen zu überspringen?

 
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")
'Set arrRange = ThisWorkbook.Names("arrRange").RefersToRange

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("B2:W" & intRow).SpecialCells(xlCellTypeVisible).Copy
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 :-)