Nested Loop- VBA- Copy each worksheet where the worksheet name matches file name in specific folder

dcola12 0
Viewed 48

**Update 9/21/22- Updated VBA code located below. I have the sheets being copied from one workbook to the target workbooks; however its not copying only the worksheet with a name that is contained in the target workbook's file name. Its copying all tabs to each file in target location. I think I have the order of tasks messed up. It seems like the copying all happens when I debug on "Set wb = Workbooks.Open(wbFile.Path)". Thank you in Advance!

I am looking to create a nested loop or at least I think that will accomplish this task. I have a worksheet with individual sheets that I want to copy to existing workbooks. The target workbooks' file names contain the tab's name within the file name. I want to loop through each worksheet and add it to the beginning of the matching workbook.

I believe my current struggle is setting the target workbook so i can make changes to it within the 2nd loop. Thank you in Advance!

'''
Sub updates()

Dim ws As Worksheet
Dim wb As Workbook
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder("C:\Users\report")


Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets

If ws.Index > 2 Then
    'folder location
    For Each wbFile In fldr.Files
    
    On Error Resume Next
    If fso.GetExtensionName(InStr(wbFile.Name, ws)) > 0 Then
    Set wb = Workbooks.Open(wbFile.Path)
    ws.Copy Before:=wb.Sheets(1)

    


    ActiveWorkbook.Save
    ActiveWorkbook.Close SaveChanges:=True

End If
Next wbFile
    
End If
Next ws

Application.ScreenUpdating = True

End Sub
'''
nested-loops vba excel
1 Answers

Posting my comments as an answer, which should resolve your issue:

Sub updatewkbks()
    toggleAppProperties False
    Dim sourceWS As Worksheet
    For Each sourceWS In ThisWorkbook.Worksheets
        'UPDATE - Make sure the first 2 sheets are skipped so we dont creates sheets for them.
        If sourceWS.Index > 2 Then
            Dim MyObj As Object
            Dim folderLocation as Object:  Set folderLocation = MyObj.GetFolder("insertfilelocationhere")
            Dim fileInFolder As Variant
            For Each fileInFolder In folderLocation.Files
                If InStr(fileInFolder.Name, sourceWS) > 0 Then
                    Dim destinationWB As Workbook:  Set destinationWB = Workbooks.Open(MySource.fileInFolder)
                    sourceWS.Copy Before:=destinationWB.Sheets(1)
                    destinationWB.Save
                    destinationWB.Close SaveChanges:=True
                    Exit For
                End If
            Next fileInFolder
        End If
    Next sourceWS
    toggleAppProperties True
End Sub

Private Sub toggleAppProperties(val as Boolean)
    With Application
        .EnableEvents = val
        .ScreenUpdating = val
    End With
End Sub

Added a subroutine to support turning items off, which has a name indicative of its intent. I also moved your dimensioning of variables to where they are used, whereas you don't need to scroll to a block of dimensions at the top to remember/see what you did. Some variables have been updated to be more descriptive, where I've removed comments.

Removed ActiveWorkbook references in the .Save/.Close... verify you're closing the correct one... i referenced destinationWB.

Edit1: Removed "=" from the toggleAppProperties related to parameters

userDazd0
Related