Copying and pasting rows in a new worksheet - excel

Question

I'm having trouble copying rows from multiple sheets to a new worksheet. The code I now have is as following:
Sub Samenvoegen()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Index"
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Range("2:2").Select
Range(Selection, Cells(Rows.Count, "2:2").End(xlUp)).Copy Range("2:2") ' select all cells in this sheets
' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
For example: I have 10 worksheets in my excel file and if I use this macro, it merges row 2 from all those excel worksheets into 1 worksheet named "Index" and pastes per worksheet under each other. Thats what I want. But the problem with this macro is that it copies the second row from the first worksheet correct. But after that first worksheet it copies from B2 from the second worksheet and C2 from the third worksheet and so on..
I would like to have a macro which copies all of the second row from the worksheets and pastes it into the new worksheet under each other. What am I doing wrong here?

Answer 1

Sub Samenvoegen()
Dim ws As Worksheet, wb As Workbook, i As Long
Set wb = ThisWorkbook
wb.Sheets.Add ' add a sheet in first place
wb.Sheets(1).Name = "Index"
' work through sheets
i = 1
For Each ws In wb.Sheets ' from sheet 2 to last sheet
If ws.Name <> "Index" Then
' copy row(2) into the new sheet
ws.Rows(2).Copy
wb.Sheets("Index").Range("A" & i).PasteSpecial xlPasteValues
i = i + 1
End If
Next
End Sub