vba not sure what is the problem but maybe because of #n/a in the worksheet

A

anisf

New Member
Joined
Apr 13, 2017
Messages
1
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:
....................
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:

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
Hi anisf
You stated that "but then got error and the code stop running"
What does the error said?
Error text are very helpful to solve them
Cheers
Sergio
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
Consolodate data to matching columns
Replies
0
Views
288
PippaThePointer
P
S
  • Solved
VBA does not continue to copy after blank cell
Replies
8
Views
514
jolivanes
jolivanes
excelbytes
  • Solved
Subscript Out Of Range Error 9
Replies
2
Views
439
excelbytes
excelbytes
E
  • Question
VBA Copy and paste rows but keep formulas in place
Replies
2
Views
259
Darmlucht
D
A
  • Question
Why is Copy Paste so slow???
Replies
7
Views
712
actorcat2000
A

Forum statistics

Threads
1,214,635
Messages
6,120,660
Members
448,975
Latest member
sweeberry

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top