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 |
This comment has been minimized.
This comment has been minimized.
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. If you not understand my question, sorry my poor english.. ! 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 |
This comment has been minimized.
This comment has been minimized.
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? |
This comment has been minimized.
This comment has been minimized.
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, |
This comment has been minimized.
This comment has been minimized.
Hello Dan, Thanks for sharing your code. Anyway, its possible also to add another column for the worksheet name from where it was copied. br, |
This comment has been minimized.
This comment has been minimized.
Hi, Thanks for the code. I have about 64 files (each having around 25000 line data). This code helped me in combining the files. But, if one of the 64 file is corrupted the code is interrupted and stops execution. Could you help me in fixing this? All i want is can this code be modified such that in case it encounters a erroneous files, it skip the file and continue to combine the other files and at end send a message or report about which files was skipped ? |
This comment has been minimized.
This comment has been minimized.
Hey @hellobm25 -- I think you can address this by catching the error that occurs when a corrupted file is opened (or attempted to be opened). The "On Error" write-up here is great: https://excelmacromastery.com/vba-error-handling/ What is the error? Thanks! -Dan |
This comment has been minimized.
This comment has been minimized.
Dear Dan,
Thank you for the prompt response. Below is the error I encountered.
[image: image.png]
…On Tue, Jul 28, 2020 at 9:18 PM Dan Wagner ***@***.***> wrote:
***@***.**** commented on this gist.
------------------------------
Hey @hellobm25 <https://github.com/hellobm25> -- I think you can address
this by catching the error that occurs when a corrupted file is opened (or
attempted to be opened).
The "On Error" write-up here is great:
https://excelmacromastery.com/vba-error-handling/
What is the error?
Thanks! -Dan
—
You are receiving this because you were mentioned.
Reply to this email directly, view it on GitHub
<https://gist.github.com/040402917376969bf362#gistcomment-3395071>, or
unsubscribe
<https://github.com/notifications/unsubscribe-auth/AQNYSDAMUSMY26MNGOBDVPLR53XNLANCNFSM4PKTPLGQ>
.
--
Thanks,
M.Bhargavi
|
This comment has been minimized.
This comment has been minimized.
Hey @hellobm25 -- the image is not showing, can you write in the error? Thanks! -Dan |
This comment has been minimized.
This comment has been minimized.
Dear Dan,
Sorry for the trouble. Here is the error message.
Excel cannot open the file because the file format or file extension is not
valid. Verify that the file has not been corrupted and that the file
extension matches the format of the file.
This is the error message. The file is basically empty. The extension and
format are correct.
…On Wed., 29 Jul. 2020, 5:28 pm Dan Wagner, ***@***.***> wrote:
***@***.**** commented on this gist.
------------------------------
Hey @hellobm25 <https://github.com/hellobm25> -- the image is not
showing, can you write in the error? Thanks! -Dan
—
You are receiving this because you were mentioned.
Reply to this email directly, view it on GitHub
<https://gist.github.com/040402917376969bf362#gistcomment-3396462>, or
unsubscribe
<https://github.com/notifications/unsubscribe-auth/AQNYSDB2BLW5XVAUNUKY6ILR6AFG7ANCNFSM4PKTPLGQ>
.
|
This comment has been minimized.
This comment has been minimized.
Hey @hellobm25 -- OK cool, in order to address this you should wrap your loop in an "OnError" handler like Chip Pearson describes: http://www.cpearson.com/excel/ErrorHandling.htm ^-- inside the ErrorHandler: piece, you can store the file name inside a collection then dump all those filenames to a MsgBox at the end of the script so you know which ones failed. From Chip's examples:
Thanks! -Dan |
This comment has been minimized.
This comment has been minimized.
Dear Dan,
Thanks for the reply!! I tried with the Error handler as suggested but my
problem still persists.
For test purpose, i created a folder on desktop and kept 5 files inside
the folder. File 1 and File 3 is corrupted. I executed the below code and
after execution i see that instead of having 3 sheets(as only 3 is error
less out of 5) i saw the program created 8 sheets. meaning, it has
processed file 1 since it is corrupted moved to the second file copied it
moved to the third file since that is corrupted, it again resumed execution
from first so i saw second file copied twice and for each file it copied it
has opened a new sheet.
Dont know what mistake i'm doing. But cannot fix it. Please help!
Sub GetSheets()
path = "MY FILE PATH\"
On Error GoTo errHandler1
fileName = Dir(path & "*.*")
Do While fileName <> ""
Workbooks.Open fileName:=path & fileName, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(fileName).Close
fileName = Dir()
Loop
Exit Sub
errHandler1:
Debug.Print Err.Number & ": " & Err.Description
Resume Next
End Sub
…On Fri, Jul 31, 2020 at 6:10 PM Dan Wagner ***@***.***> wrote:
***@***.**** commented on this gist.
------------------------------
Hey @hellobm25 <https://github.com/hellobm25> -- OK cool, in order to
address this you should wrap your loop in an "OnError" handler like Chip
Pearson describes:
http://www.cpearson.com/excel/ErrorHandling.htm
^-- inside the ErrorHandler: piece, you can store the file name inside a
collection then dump all those filenames to a MsgBox at the end of the
script so you know which ones failed.
From Chip's examples:
On Error GoTo ErrHandler:
N = 1 / 0
Debug.Print N
Exit Sub
ErrHandler:
N = 1
' go back to the line following the error
Resume Next
Thanks! -Dan
—
You are receiving this because you were mentioned.
Reply to this email directly, view it on GitHub
<https://gist.github.com/040402917376969bf362#gistcomment-3399363>, or
unsubscribe
<https://github.com/notifications/unsubscribe-auth/AQNYSDFR4R7QHJGD3ETSFODR6K3S3ANCNFSM4PKTPLGQ>
.
--
Thanks,
M.Bhargavi
|
This comment has been minimized.
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
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