Hente fra mange ark

Public Sub CopyFørsteRække()
'Ret "Ark1" til navnet på det ark du vil have dataerne på
X = 1
Antal = Worksheets.Count
For Each Ws In Worksheets
If Ws.Name <> "Ark1" Then
Worksheets(Ws.Name).Rows("1:1").Copy
Sheets("Ark1").Paste Destination:=Worksheets("Ark1").Cells(X, 1)
X = X + 1
  End If
Next
Worksheets("Ark1").Select
Range("A2").Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

Sættes i et modul

Hej Kabak
tak for hurtigt svar.
Det virker fuldstændigt efter hensigten.
Jeg har et tillægsspørgsmål, hvis det kan lade sig gøre.
Jeg har ikke formuleret spørgsmålet helt som jeg egentlig mente.
Hvis nu den skal plukke nogle celler ud.
F.eks. fra alle "A1" til "ark1 "A2" og nedefter.
      fra alle "B4" til "ark1 "B2" og nedefter.
      fra alle "D2" til "ark1 "C2" og nedefter.
      fra alle "N6" til "ark1 "D2" og nedefter.
Hvis det kan lade sig gøre er det helt perfekt.
Kom med svar, så skal du få point.

Public Sub CopyFørsteRække()
'Ret "Ark1" til navnet på det ark du vil have dataerne på
X = 2
Antal = Worksheets.Count
For Each Ws In Worksheets
If Ws.Name <> "Ark1" Then
Worksheets(Ws.Name).Range("A1").Copy
Sheets("Ark1").Paste Destination:=Worksheets("Ark1").Cells(X, 1)
Worksheets(Ws.Name).Range("B4").Copy
Sheets("Ark1").Paste Destination:=Worksheets("Ark1").Cells(X, 2)
Worksheets(Ws.Name).Range("D2").Copy
Sheets("Ark1").Paste Destination:=Worksheets("Ark1").Cells(X, 3)
Worksheets(Ws.Name).Range("N6").Copy
Sheets("Ark1").Paste Destination:=Worksheets("Ark1").Cells(X, 4)
X = X + 1
  End If
Next
Worksheets("Ark1").Select
Range("A2").Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
       
       

End Sub

Super !!!!!

Tak for hjælpen.