簡體   English   中英

嵌套循環-VBA-復制工作表名稱與特定文件夾中的文件名匹配的每個工作表

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

我正在尋找創建一個嵌套循環,或者至少我認為這將完成這項任務。 我有一個工作表,其中包含要復制到現有工作簿的各個工作表。 目標工作簿的文件名包含文件名中的選項卡名稱。 我想遍歷每個工作表並將其添加到匹配工作簿的開頭。

我相信我目前的斗爭是設置目標工作簿,以便我可以在第二個循環中對其進行更改。 先感謝您!

'''
Sub updatewkbks()
'Declare all the variables.
    Dim ws As Worksheet
    Dim wkb As Workbook
    Dim var As Variant
    Dim MyObj As Object, MySource As Object, file As Variant
   
'Turn screen updating off to speed up your macro code
    Application.ScreenUpdating = False
'Start the looping through sheets
    For Each ws In ThisWorkbook.Worksheets
'UPDATE - Make sure the first 2 sheets are skipped so we dont creates sheets for them.
    If ws.Index > 2 Then
        'folder location
        Set MySource = MyObj.GetFolder("insertfilelocationhere")
        For Each file In MySource.Files
        On Error Resume Next
'find matching file        
        If InStr(file.Name, ws) > 0 Then
        'set workbook to copy to
        Set wkb = Workbooks.Open(MySource.Files)
        ws.Copy Before:=wkb.Sheets(1)
        ActiveWorkbook.Save
        ActiveWorkbook.Close SaveChanges:=True

'Loop to next file to find match
    End If
    Next file
        
'loop to next worksheet to copy
    End If
    Next ws
'Turn screen updating on
    Application.ScreenUpdating = True
    
End Sub
'''

發表我的評論作為答案,這應該可以解決您的問題:

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

添加了一個子例程以支持關閉項目,其名稱表明其意圖。 我還將變量的尺寸標注移動到使用它們的位置,而您無需滾動到頂部的尺寸塊即可記住/查看您所做的事情。 一些變量已更新為更具描述性,我刪除了評論。

刪除了.Save/.Close中的ActiveWorkbook引用...驗證您正在關閉正確的...我引用了destinationWB

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM