Instantly share code, notes, and snippets.

Embed
What would you like to do?
This macro combines data from many sheets into a single sheet
Option Explicit
Public Sub CombineDataFromAllSheets()
Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
'Notes: "Src" is short for "Source", "Dst" is short for "Destination"
'Set references up-front
Set wksDst = ThisWorkbook.Worksheets("Import")
lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)!
lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)!
'Set the initial destination range
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
'Loop through all sheets
For Each wksSrc In ThisWorkbook.Worksheets
'Make sure we skip the "Import" destination sheet!
If wksSrc.Name <> "Import" Then
'Identify the last occupied row on this sheet
lngSrcLastRow = LastOccupiedRowNum(wksSrc)
'Store the source data then copy it to the destination range
With wksSrc
Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol))
rngSrc.Copy Destination:=rngDst
End With
'Redefine the destination range now that new data has been added
lngDstLastRow = LastOccupiedRowNum(wksDst)
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
End If
Next wksSrc
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT : Sheet, the worksheet we'll search to find the last row
'OUTPUT : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End With
Else
lng = 1
End If
LastOccupiedRowNum = lng
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT : Sheet, the worksheet we'll search to find the last column
'OUTPUT : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End With
Else
lng = 1
End If
LastOccupiedColNum = lng
End Function
@saimhas

This comment has been minimized.

saimhas commented Jul 17, 2016

I Have this code
Sub COPY_DATA()
Dim My_sheet As Worksheet
Dim My_Rg As Range
Dim lr, i, lc, Next_Row, Lr_master, Lc_master As Integer

With Sheets("master")
    Lr_master = .Cells(Rows.Count, 1).End(3).Row
    Lc_master = .Cells(1, Columns.Count).End(1).Column
    .Range("a2").Resize(Lr_master, Lc_master).ClearContents
End With

Next_Row = 2
For i = 1 To Sheets.Count
Set My_sheet = Sheets(i)
If My_sheet.Name <> "Master" Then
With My_sheet
lr = .Cells(Rows.Count, 1).End(3).Row
lc = .Cells(1, Columns.Count).End(1).Column
.Range("a2").Resize(lr - 1, lc).Copy Destination:=Sheets("Master").Cells(Next_Row, 1)
Next_Row = Next_Row + lr - 1
End With
End If
Next
End Sub

@missUtoo

This comment has been minimized.

missUtoo commented Aug 11, 2016

Dear Dan, thanks to sharing this it works like fast train.

I have problem bcze I'm totally new on this VBA.. how I can make range or tell that I not want to touch sheets 1-10 and it collect data all other sheet.
I have all PO's on right side more then 300 and left side after my "MSTR" which is same as you have import. so it only collect same data all PO's which i use for make Pivot tables as client want.
Your code is so fast and I like to use this one rater what I use now.. I have make copy paste my code 3 part and it work but I have problem... all PO's that I change later.. I can't add or delete any row and whiteout going MSTR to delete or add row manually.. So I test you code this way that each time I import first I delete all and then import all data again.. and this way it keep all up to date if I add or delete come row in my PO's... But my problem is now how I can tell this code... that I want only range of pages or not touch range of sheets when it collect data.

If you not understand my question, sorry my poor english.. !
I can then send you email my PO's and master sheet for look my problem.

Thanks a again you tutorials, these are best so far I find.. you always have some real work that you make in your tutorials that people rally understand that can be use and same time to learn.

Brads

Markko

@badbowler10

This comment has been minimized.

badbowler10 commented Mar 20, 2017

Does this VBA continue to run as more entries are made on the separate sheets or will the macro need to be ran each time?

@ayhanakgun7777

This comment has been minimized.

ayhanakgun7777 commented Feb 27, 2018

Hello Dan

I have a file which has many sheets and I need to combine all sheets in one sheet. I tried to do that by VB but not succeed. Can you please kindly help me for that ? I can send the file to you via e-mail If you share.

I will be much appreciated for your help

thanks

Regards,

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment