Data fra et ark til et andet hvis felt har værdi

Er det alle kolonner, der skal overføres?

Alle kolonner - lige pånær Kriterierne skal overføres.

Dim antalRækker As Long, ræk As Long, ræk2 As Long
Dim tilArk As Worksheet
Public Sub overførTilArk2()
    antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
    Set tilArk = ActiveWorkbook.Sheets("Ark2")
    ræk2 = 2
   
    Application.ScreenUpdating = False
   
    For ræk = 2 To antalRækker
        If erKriterieOpfyldt(ræk) = True Then
            overfør ræk
        End If
    Next ræk
   
    Application.ScreenUpdating = True
   
    tilArk.Activate
    tilArk.Columns.AutoFit
End Sub
Private Function erKriterieOpfyldt(ræk)
Dim område As Range, cc
    Set område = Range("E" & ræk & ":G" & ræk)
    For Each cc In område.Cells
        If cc.Value = 1 Then
            erKriterieOpfyldt = True
            Exit Function
        End If
    Next cc
    erKriterieOpfyldt = False
End Function
Private Sub overfør(ræk)
Dim område As Range
    Set område = Range("A" & ræk & ":D" & ræk)
    område.Select
    Selection.Copy
   
    tilArk.Activate
    tilArk.Range("A" & ræk2).Select
    tilArk.Paste
    ræk2 = ræk2 + 1
       
    Sheets(1).Select
    Application.CutCopyMode = False
   
End Sub

Hej Supertekst!

Super .... Det var lige sådan den skulle være. Så kan jeg selv bygge videre på den.....

Mange tak

Selv tak - men skulle du ikke have Accepteret mit Svar - i stedet for selv at lægge et?

Det er så udført - tak.. ..