VBA code to copy and paste data in one sheet from multiple sheet and loop through

Maybe this?

Sub ConsolidateData()
    Dim ws As Worksheet
    
    Sheets.Add.Name = "allyears"
    For Each ws In ThisWorkbook.Sheets
        With ws
            If ws.Name <> "allyears" Then
                .Range("A11:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
                Sheets("allyears").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            End If
        End With
    Next ws
End Sub

BSB

Thank you. This code works but the it repeats copying column A data repetedly also instead of pasting data horizontally it paste data after under let's say when pasting data for 2006 is done it put the ddata for 2007 right below it

Originally Posted by BadlySpelledBuoy

Maybe this?

Sub ConsolidateData()
    Dim ws As Worksheet
    
    Sheets.Add.Name = "allyears"
    For Each ws In ThisWorkbook.Sheets
        With ws
            If ws.Name <> "allyears" Then
                .Range("A11:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
                Sheets("allyears").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            End If
        End With
    Next ws
End Sub

BSB

Thank you. This code works but the it repeats copying column A data repetedly also instead of pasting data horizontally it paste data after under let's say when pasting data for 2006 is done it put the ddata for 2007 right below it

I see the sheets for 2006-2013 are the same size, maybe this code:

Sub Button1_Click()
Dim ws As Worksheet, n%
For Each ws In ThisWorkbook.Sheets
    If ws.Name <> "allyears" Then
        n = n + 1
        With Sheets("allyears")
            .Range("A3").Offset(0, n).Value = ws.Name
            .Range("A4:A57").Offset(0, n).Value _
            = ws.Range("B11:B64").Value
        End With
    End If
Next ws
End Sub

So you want the results pasted side by side rather in one long list?

BSB

Originally Posted by BadlySpelledBuoy

So you want the results pasted side by side rather in one long list?

BSB

Yes side by side only the numbers as the Column A11:A64 is same for every year. Also if I could add the year headers would be great.

Sub ConsolidateData()
    Dim ws As Worksheet
    
    Sheets.Add.Name = "allyears"
    
    With Sheets("year2006")
        .Range("A10:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
    End With
    
    Sheets("allyears").Range("A1").PasteSpecial xlPasteValues
    
    For Each ws In ThisWorkbook.Sheets
        With ws
            If ws.Name <> "allyears" Then
                .Range("B11:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
                With Sheets("allyears")
                    .Cells(2, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial xlPasteValues
                    .Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) = ws.Name
                End With
            End If
        End With
    Next ws
    
    Sheets("allyears").Columns.AutoFit
End Sub

BSB

Originally Posted by BadlySpelledBuoy

Sub ConsolidateData()
    Dim ws As Worksheet
    
    Sheets.Add.Name = "allyears"
    
    With Sheets("year2006")
        .Range("A10:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
    End With
    
    Sheets("allyears").Range("A1").PasteSpecial xlPasteValues
    
    For Each ws In ThisWorkbook.Sheets
        With ws
            If ws.Name <> "allyears" Then
                .Range("B11:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
                With Sheets("allyears")
                    .Cells(2, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial xlPasteValues
                    .Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) = ws.Name
                End With
            End If
        End With
    Next ws
    
    Sheets("allyears").Columns.AutoFit
End Sub

BSB

Thank you. I just tired to understand the code you sent understood every bit of it. Thank you !

Happy I could help.

Thanks for the rep and don't forget to mark the thread as SOLVED if you're happy you have a working solution.

BSB