Samle rækker der indeholder data

Rem Koden indsættes i ThisWorkBook
Rem Faneblad 7 forudsættes oprettet med de 4 overskrifter
Rem =====================================================
Dim antalKol, ark7Ræk, prisArk
Sub samlingAfRækker()
    Application.ScreenUpdating = False
   
Rem Række påArk7
    ark7Ræk = 2

Rem gennemløb af de 6 ark
        For ark = 1 To 6
            ActiveWorkbook.Sheets(ark).Activate
            Set prisArk = ActiveWorkbook.Sheets(ark)
            testArket
        Next ark
       
        Application.ScreenUpdating = True
        ActiveWorkbook.Sheets(7).Activate
        MsgBox ("Samling er afsluttet")
End Sub
Private Sub testArket()
        For ræk = 2 To 65000
            prisArk.Activate
            With prisArk
                If .Cells(ræk, 1) = "" Then
                    Exit Sub
                End If
           
Rem kopier til ark7
                If .Cells(ræk, 3) <> "" Or IsEmpty(.Cells(ræk, 3)) = true½ Then
                    Range(.Cells(ræk, 1), .Cells(ræk, 4)).Select
                    Selection.Copy
                   
                    ActiveWorkbook.Sheets(7).Select
                    Cells(ark7Ræk, 1).Select
                    Selection.PasteSpecial (xlPasteAll)
                   
                    Application.CutCopyMode = False
                    ark7Ræk = ark7Ræk + 1
                End If
            End With
        Next ræk
End Sub

super, det ser godt ud...
Linien med: Range(.Cells(ræk, 1), .Cells(ræk, 2)).Select
Hvordan tager jeg hele rækken med, og ikke kun de to celler med?

Så vidt jeg kan se - bliver alle 4 celler i rækken kopieret:

  Range(.Cells(ræk, 1), .Cells(ræk, 4)).Select

OBS: ½ efter true skal slettes

Du har ret, jeg havde bare lige en kolonne der var skjult, og derfor blev data ikke vist korrekt :)

Takker, læg lige et svar

Selv tak - du får et svar