copy and stack all tabs data to one sheet in another workbook using vba

NateD1

New Member
Joined
Apr 1, 2020
Messages
27
Office Version
  1. 365
Platform
  1. Windows
Hi All,
i have the below code i found which copys all data in multiple tabs in a workbook to one sheet.
would some one be able to adjust this code or simplifying so that it only copies particular tabs instead of all tabs. (i.e only Sheet1,Sheet3,Sheet4,Sheet5)
i need all this data then exported into another work book.

example of what ideally id like it to do, Main workbook where data to be copied to: workbook1, data where is stored and macro combines sheets: Workbook2
workbook 1, run macro > opens workbook 2 > combines all data on named tabs > exports combined stacked data to "Sheet1" on workbook1 > close Workbook2

VBA Code:
Sub Combine()
    Dim J As Integer
    Dim s As Worksheet

    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add ' add a sheet in first place
    Sheets(1).Name = "Combined"

    ' copy headings
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")

    For Each s In ActiveWorkbook.Sheets
        If s.Name <> "Combined" Then
            Application.GoTo Sheets(s.Name).[a1]
            Selection.CurrentRegion.Select
            ' Don't copy the headings
            Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
            Selection.Copy Destination:=Sheets("Combined"). _
              Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    Next
End Sub

thanks
 

Some videos you may like

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
792
Office Version
  1. 2013
Platform
  1. Windows
Hi
VBA Code:
Sub Combine()
    Dim J As Integer
    Dim s As Worksheet

    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add    ' add a sheet in first place
    Sheets(1).Name = "Combined"

    ' copy headings
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")
    Reqsheets = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
    For i = 1 To UBound(Reqsheets)
        Application.GoTo Sheets(i).[a1]
        Selection.CurrentRegion.Select
        ' Don't copy the headings
        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
        Selection.Copy Destination:=Sheets("Combined"). _
                                    Cells(Rows.Count, 1).End(xlUp)(2)
    End If
Next
End Sub
 

NateD1

New Member
Joined
Apr 1, 2020
Messages
27
Office Version
  1. 365
Platform
  1. Windows
Hi
VBA Code:
Sub Combine()
    Dim J As Integer
    Dim s As Worksheet

    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add    ' add a sheet in first place
    Sheets(1).Name = "Combined"

    ' copy headings
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")
    Reqsheets = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
    For i = 1 To UBound(Reqsheets)
        Application.GoTo Sheets(i).[a1]
        Selection.CurrentRegion.Select
        ' Don't copy the headings
        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
        Selection.Copy Destination:=Sheets("Combined"). _
                                    Cells(Rows.Count, 1).End(xlUp)(2)
    End If
Next
End Sub
for some reason it doesnt work at all now...
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
792
Office Version
  1. 2013
Platform
  1. Windows
Then try
VBA Code:
Reqsheets = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
    For Each s In Reqsheets
        Application.GoTo Sheets(s).[a1]
        Selection.CurrentRegion.Select
        ' Don't copy the headings
        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
        Selection.Copy Destination:=Sheets("Combined"). _
                                    Cells(Rows.Count, 1).End(xlUp)(2)
                                    ...
 

NateD1

New Member
Joined
Apr 1, 2020
Messages
27
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Then try
VBA Code:
Reqsheets = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
    For Each s In Reqsheets
        Application.GoTo Sheets(s).[a1]
        Selection.CurrentRegion.Select
        ' Don't copy the headings
        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
        Selection.Copy Destination:=Sheets("Combined"). _
                                    Cells(Rows.Count, 1).End(xlUp)(2)
                                    ...
not sure what i was doing wrong but couldnt get it to work, i found this one on another thread which works now by selecting Sheets numbers 3 to 7.
do you know what i can add to this code that will open another workbook via file path/filename, run this macro, and then return the "master Sheet" data?

VBA Code:
Sub Copy_Sheets_To_Master()

Application.ScreenUpdating = False

Dim i As Long
Dim Lastrow As Long
Dim ans As Long

For i = 3 To 7
With Sheets(i)
    ans = .Cells(Rows.Count, "A").End(xlUp).Row
    Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Cells(2, 1).Resize(ans, 7).Copy Sheets("Master").Cells(Lastrow, 1)
End With
Next
Application.ScreenUpdating = True
End Sub
 

NateD1

New Member
Joined
Apr 1, 2020
Messages
27
Office Version
  1. 365
Platform
  1. Windows
not sure what i was doing wrong but couldnt get it to work, i found this one on another thread which works now by selecting Sheets numbers 3 to 7.
do you know what i can add to this code that will open another workbook via file path/filename, run this macro, and then return the "master Sheet" data?

VBA Code:
Sub Copy_Sheets_To_Master()

Application.ScreenUpdating = False

Dim i As Long
Dim Lastrow As Long
Dim ans As Long

For i = 3 To 7
With Sheets(i)
    ans = .Cells(Rows.Count, "A").End(xlUp).Row
    Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Cells(2, 1).Resize(ans, 7).Copy Sheets("Master").Cells(Lastrow, 1)
End With
Next
Application.ScreenUpdating = True
End Sub
if anyone knows how to add this to this code that would be a great help for me, as having to copy and paste it manually from another work book each time after running the above.
example: workbook1 (current open) > run macro > opens closed workbook2 via file path (the name of the file is the same, except date at end changes daily( WB2 19.11.2020) > runs above code in WB2 to combine sheets > paste data to WB1 sheet1.
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
9,971

ADVERTISEMENT

Try:
VBA Code:
Sub Copy_Sheets_To_Master()
    Application.ScreenUpdating = False
    Dim flder As FileDialog, FileName As String, FileChosen As Integer, wkbSource As Workbook, wsDest As Worksheet, ws As Worksheet, lRow As Long
    Set wsDest = ThisWorkbook.Sheets("Master")
    Set flder = Application.FileDialog(msoFileDialogFilePicker)
    flder.Title = "Please Select a folder and file."
    FileChosen = flder.Show
    FileName = flder.SelectedItems(1)
    Set wkbSource = Workbooks.Open(FileName)
    For Each ws In Sheets(Array("Sheet1", "Sheet3", "Sheet4", "Sheet5"))
        With ws
            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Cells(2, 1).Resize(lRow - 1, 7).Copy wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub
 

NateD1

New Member
Joined
Apr 1, 2020
Messages
27
Office Version
  1. 365
Platform
  1. Windows
Try:
VBA Code:
Sub Copy_Sheets_To_Master()
    Application.ScreenUpdating = False
    Dim flder As FileDialog, FileName As String, FileChosen As Integer, wkbSource As Workbook, wsDest As Worksheet, ws As Worksheet, lRow As Long
    Set wsDest = ThisWorkbook.Sheets("Master")
    Set flder = Application.FileDialog(msoFileDialogFilePicker)
    flder.Title =[B] "Z:\Filelocation\filename.xlsb"[/B]
    FileChosen = flder.Show
    FileName = flder.SelectedItems(1)
    Set wkbSource = Workbooks.Open(FileName)
    For Each ws In Sheets(Array("Sheet1", "Sheet3", "Sheet4", "Sheet5"))
        With ws
            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Cells(2, 1).Resize(lRow - 1, 7).Copy wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub
thank you for repling, when i run it i cant get past this part of the code FileName = flder.SelectedItems(1), i have added in the file location as above.
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
9,971
Try:
VBA Code:
Sub Copy_Sheets_To_Master()
    Application.ScreenUpdating = False
    Dim wkbSource As Workbook, wsDest As Worksheet, ws As Worksheet, lRow As Long
    Set wsDest = ThisWorkbook.Sheets("Master")
    Set wkbSource = Workbooks.Open("Z:\Filelocation\filename.xlsb")
    For Each ws In Sheets(Array("Sheet1", "Sheet3", "Sheet4", "Sheet5"))
        With ws
            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Cells(2, 1).Resize(lRow - 1, 7).Copy wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    Next ws
    wkbSource.Close False
    Application.ScreenUpdating = True
End Sub
 
Solution

NateD1

New Member
Joined
Apr 1, 2020
Messages
27
Office Version
  1. 365
Platform
  1. Windows
Try:
VBA Code:
Sub Copy_Sheets_To_Master()
    Application.ScreenUpdating = False
    Dim wkbSource As Workbook, wsDest As Worksheet, ws As Worksheet, lRow As Long
    Set wsDest = ThisWorkbook.Sheets("Master")
    Set wkbSource = Workbooks.Open("Z:\Filelocation\filename.xlsb")
    For Each ws In Sheets(Array("Sheet1", "Sheet3", "Sheet4", "Sheet5"))
        With ws
            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Cells(2, 1).Resize(lRow - 1, 7).Copy wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    Next ws
    wkbSource.Close False
    Application.ScreenUpdating = True
End Sub
Amazing it works perfectly thank you so much!!, one last thing sorry.. on the end of the file name it has a date that changes. can i = the file name to a cell? so i can change the date each day ?
 

Watch MrExcel Video

Forum statistics

Threads
1,118,521
Messages
5,572,627
Members
412,475
Latest member
JaredNAU
Top