Hi guys,
I am a newbie in vba. I have been thinking this for so many days and cannot seem to find the solution and decide to seek for some help here.
I need to copy some information (cells) from worksheet("name") in multiple workbooks stored in multiple subfolders in a folder into a master final worksheet (combinesheet). I have figured out the code and when I ran the code using my sample excel files, it works just fine. But the issue here, when I ran the code on my real excel files, it can run on certain worksheets but then got error and the code stop running. I found the problem is maybe because of #N/A error that available in the certain worksheet due to the failed calculation (I cannot do anything on the failed calculation since it is from other people). The code stop running after it has copied and pasted the value on the final worksheets("combinesheet"). Actually, I also have tried to put the 'on error resume next' and 'on error goto 0' and the code did not break and ran on all worksheets but then the final worksheet("combinesheet") got duplicated at the pasted cells from worksheets that contain the n/a error.
Here I attach my sloppy code:
....................
.......................................
How do I fix this so that the code will still run through all the worksheet and return the desired result? please help me to figure out this. Thank you very much.
I am a newbie in vba. I have been thinking this for so many days and cannot seem to find the solution and decide to seek for some help here.
I need to copy some information (cells) from worksheet("name") in multiple workbooks stored in multiple subfolders in a folder into a master final worksheet (combinesheet). I have figured out the code and when I ran the code using my sample excel files, it works just fine. But the issue here, when I ran the code on my real excel files, it can run on certain worksheets but then got error and the code stop running. I found the problem is maybe because of #N/A error that available in the certain worksheet due to the failed calculation (I cannot do anything on the failed calculation since it is from other people). The code stop running after it has copied and pasted the value on the final worksheets("combinesheet"). Actually, I also have tried to put the 'on error resume next' and 'on error goto 0' and the code did not break and ran on all worksheets but then the final worksheet("combinesheet") got duplicated at the pasted cells from worksheets that contain the n/a error.
Here I attach my sloppy code:
....................
Code:
Sub CopyDataFromMultiWorksheets()
Dim sh As Worksheet
Dim SaveDriveDir As String
Dim FName As Variant
Dim LastCol As Long
Dim DestSh As Worksheet
Dim Last As Long
Dim Fs As Object 'FileSystem
Dim D As Object 'Folder
Dim Fx As Object 'Subfolder
Dim File As Object 'File
Dim PathName As String
Dim iRow As Long 'next available row index of destination worksheet
Dim LRow As Long 'last row of source worksheet
Dim rng As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Delete the sheet "CombineSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("CombineSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Add a worksheet with the name "CombineSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "CombineSheet"
DestSh.Range("A1").Value = "Officer "
DestSh.Range("B1").Value = "template_name "
DestSh.Range("C1").Value = "company_name"
DestSh.Range("D1").Value = "cif_no"
DestSh.Range("E1").Value = "acct_no"
DestSh.Range("F1").Value = "facility_no"
DestSh.Range("G1").Value = "product_type"
DestSh.Range("H1").Value = "indv_assess_date"
DestSh.Range("I1").Value = "impaired_date"
DestSh.Range("J1").Value = "principal_outstanding"
DestSh.Range("K1").Value = "npv_cashflow"
DestSh.Range("L1").Value = "llp_todate"
DestSh.Range("M1").Value = "llp_prev_mth"
DestSh.Range("N1").Value = "llp_charge_wback"
Set Fs = CreateObject("Scripting.FileSystemObject")
Set D = Fs.GetFolder("D:\work\contoh")
For Each Fx In D.subfolders 'loop through subfolders
For Each File In Fx.Files 'loop through files
If File.Name Like "*.xlsx" Then
PathName = Fx.Name & "" & File.Name
Workbooks.Open D.Path & "" & PathName
Application.StatusBar = "Processing " & PathName
Set sh = Worksheets("name")
'loop through all worksheets and copy the data to the DestSh
For Each Cell In sh.Range("C8:AZ8" & LastCol)
'On Error Resume Next
LastCol = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
Last = LastRow(DestSh)
i = 1
If Cell.Value = "Facility 1" Then
DestSh.Cells(Last + i, "A").Value = Replace(Application.ActiveWorkbook.Path, "D:\work\contoh", "")
DestSh.Cells(Last + i, "B").Value = Replace(ActiveWorkbook.Name, ".xlsx", "")
sh.Range("B6").Copy
DestSh.Cells(Last + i, "C").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("B5").Copy
DestSh.Cells(Last + i, "D").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("C7").Copy
DestSh.Cells(Last + i, "E").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("C8").Copy
DestSh.Cells(Last + i, "F").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("C9").Copy
DestSh.Cells(Last + i, "G").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("B7").Copy
DestSh.Cells(Last + i, "H").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
DestSh.Cells(Last + i, "H").NumberFormat = "DD-MMM-YY"
sh.Range("C23").Copy
DestSh.Cells(Last + i, "I").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
DestSh.Cells(Last + i, "I").NumberFormat = "DD-MMM-YY"
sh.Range("C27").Copy
DestSh.Cells(Last + i, "J").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("C29").Copy
DestSh.Cells(Last + i, "K").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("C31").Copy
DestSh.Cells(Last + i, "L").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("C39").Copy
DestSh.Cells(Last + i, "M").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("C41").Copy
DestSh.Cells(Last + i, "N").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ElseIf Cell.Value = "Facility 2" Then
DestSh.Cells(Last + i, "A").Value = Replace(Application.ActiveWorkbook.Path, "D:\work\contoh", "")
DestSh.Cells(Last + i, "B").Value = Replace(ActiveWorkbook.Name, ".xlsx", "")
sh.Range("B6").Copy
DestSh.Cells(Last + i, "C").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("B5").Copy
DestSh.Cells(Last + i, "D").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("F7").Copy
DestSh.Cells(Last + i, "E").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("F8").Copy
DestSh.Cells(Last + i, "F").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("F9").Copy
DestSh.Cells(Last + i, "G").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("B7").Copy
DestSh.Cells(Last + i, "H").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
DestSh.Cells(Last + i, "H").NumberFormat = "DD-MMM-YY"
sh.Range("F23").Copy
DestSh.Cells(Last + i, "I").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
DestSh.Cells(Last + i, "I").NumberFormat = "DD-MMM-YY"
sh.Range("F27").Copy
DestSh.Cells(Last + i, "J").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("F29").Copy
DestSh.Cells(Last + i, "K").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("F31").Copy
DestSh.Cells(Last + i, "L").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("F39").Copy
DestSh.Cells(Last + i, "M").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("F41").Copy
DestSh.Cells(Last + i, "N").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ElseIf Cell.Value = "Facility 3" Then
DestSh.Cells(Last + i, "A").Value = Replace(Application.ActiveWorkbook.Path, "D:\work\contoh", "")
DestSh.Cells(Last + i, "B").Value = Replace(ActiveWorkbook.Name, ".xlsx", "")
sh.Range("B6").Copy
DestSh.Cells(Last + i, "C").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("B5").Copy
DestSh.Cells(Last + i, "D").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("I7").Copy
DestSh.Cells(Last + i, "E").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("I8").Copy
DestSh.Cells(Last + i, "F").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("I9").Copy
DestSh.Cells(Last + i, "G").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("B7").Copy
DestSh.Cells(Last + i, "H").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
DestSh.Cells(Last + i, "H").NumberFormat = "DD-MMM-YY"
sh.Range("I23").Copy
DestSh.Cells(Last + i, "I").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
DestSh.Cells(Last + i, "I").NumberFormat = "DD-MMM-YY"
sh.Range("I27").Copy
DestSh.Cells(Last + i, "J").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("I29").Copy
DestSh.Cells(Last + i, "K").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("I31").Copy
DestSh.Cells(Last + i, "L").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("I39").Copy
DestSh.Cells(Last + i, "M").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("I41").Copy
DestSh.Cells(Last + i, "N").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ElseIf Cell.Value = "Facility 4" Then
DestSh.Cells(Last + i, "A").Value = Replace(Application.ActiveWorkbook.Path, "D:\work\contoh", "")
DestSh.Cells(Last + i, "B").Value = Replace(ActiveWorkbook.Name, ".xlsx", "")
sh.Range("B6").Copy
DestSh.Cells(Last + i, "C").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("B5").Copy
DestSh.Cells(Last + i, "D").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("L7").Copy
DestSh.Cells(Last + i, "E").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("L8").Copy
DestSh.Cells(Last + i, "F").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("L9").Copy
DestSh.Cells(Last + i, "G").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("B7").Copy
DestSh.Cells(Last + i, "H").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
DestSh.Cells(Last + i, "H").NumberFormat = "DD-MMM-YY"
sh.Range("L23").Copy
DestSh.Cells(Last + i, "I").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
DestSh.Cells(Last + i, "I").NumberFormat = "DD-MMM-YY"
sh.Range("L27").Copy
DestSh.Cells(Last + i, "J").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("L29").Copy
DestSh.Cells(Last + i, "K").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("L31").Copy
DestSh.Cells(Last + i, "L").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("L39").Copy
DestSh.Cells(Last + i, "M").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sh.Range("L41").Copy
DestSh.Cells(Last + i, "N").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
'On Error GoTo 0
Next
ActiveWorkbook.Close savechanges:=False
End If
Next File
Next Fx
ExitTheSub:
Application.Goto DestSh.Cells(1)
'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
.......................................
How do I fix this so that the code will still run through all the worksheet and return the desired result? please help me to figure out this. Thank you very much.
Last edited by a moderator: