VB Code for copying the same range from multiple sheets into a new sheet

[ATY807]

I have a workbook which has multiple tabs arranged in the same format. I need to select the same range from each of these tabs and paste them all into a new sheet where this range of data from each tab appears at the end of the previous one. Could someone please help with the VB code.

 

[My Aswer Is This]

Would you please explain in words what range your wanting to copy.
I cannot determine from the image the range to copy.

Please say something like:
The Range("A1: G45")

 

[jolivanes]

Like "My Answer Is This" alluded to, this should work with your Range.
It will add a sheet and name it "Master". If a Sheet with that name already exist, it will delete it so be careful.
Change your range to be copied and pasted as required.

Sub Maybe()
Dim ws As Worksheet, a As String, i As Long
Application.ScreenUpdating = False
a = ActiveSheet.Name
On Error Resume Next
    Set ws = Sheets("Master")
        If Not ws Is Nothing Then
            Application.DisplayAlerts = False
                Worksheets("Master").Delete
            Application.DisplayAlerts = True
        End If
    Set ws = Nothing
On Error GoTo 0

Worksheets.Add(, Sheets(Sheets.Count)).Name = "Master"
    For i = 1 To ActiveWorkbook.Sheets.Count - 1
        With Sheets("Master")
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(8, 9).Value = Sheets(i).Range("A1" & ":I8").Value
        End With
    Next i
Sheets(a).Select
Application.ScreenUpdating = True
End Sub

 

[ATY807]

It does work. Thank you so much jolivanes

 

[jolivanes]

Thanks for letting us know.
Good luck

 

[JackDanIce]

Alternative suggestion, clears Master sheet contents only if Master sheet already exists, otherwise adds a new sheet and names it "Master"

Sub Master_of_Puppets()
   
    Dim s As Double: s = Timer
   
    Application.StatusBar = False
       
    Populate Add_Master
   
    Application.StatusBar = "Run time: " & Round(Timer - s, 2) & " seconds"

End Sub

Private Function Add_Master() As Worksheet
       
    On Error Resume Next
    Set Add_Master = Sheets("Master")
    On Error GoTo 0
       
    If Not Add_Master Is Nothing Then
        Add_Master.Cells.Value = ""
        Add_Master.Move after:=Sheets(Sheets.Count)
    Else
        Set Add_Master = Worksheets.add(after:=Sheets(Sheets.Count))
        Sheets(Sheets.Count).Name = "Master"
    End If
   
End Function


Private Sub Populate(ByRef wks As Worksheet)

    Dim x   As Long
    Dim s   As Double: s = Timer
   
    Application.ScreenUpdating = False
   
    For x = 1 To ThisWorkbook.Sheets.Count - 1
        wks.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(8, 9) = Sheets(x).Cells(1, 1).Resize(8, 9).Value
    Next x
    wks.Activate
   
    Application.ScreenUpdating = True
       
End Sub