在单独的 Wkbks 中循环和搜索匹配的工作表；如果未找到匹配项，则添加 Wksht

Question

我有一系列按地区、地区和时期划分的工作簿，其中包含地区、地区和时期的每个组合的月度销售数据。每个地区都有一个主工作簿，其中包含每个地区的单独工作表。每月数据显示在B:M 列中。

我需要打开每个月的 District、Territory 和 Period 文件，打开相应 District 的主工作簿，搜索相应的 Territory，并将该月的数据粘贴到与该月关联的列中（例如，Feb. data粘贴在 C) 列中。之后应关闭月度文件并循环到下一个月度文件。

但是，我需要编写代码，以便在年中将新领土添加到一个地区（在最初创建该地区的主工作簿之后的某个时间）。

编写的循环想要从打开的月度文件跳转到循环代码的下一部分，这将创建一个新的工作表，但这不是我们所需要的。

有解决此问题的建议吗？这是我目前所拥有的：

Sub DSMReportsP02()

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim DistrictDSM As Range, DistrictsDSMList As Range
    Dim Period As String, Path As String, DistPeriodFile As String, Territory As String
    Dim YYYY As Variant
    Dim WBMaster As Workbook, DistMaster As Workbook, CurDstTerrFile As Workbook
    Dim wsCount As Integer, x As Integer
    Dim wsExists As Boolean

    Set DistrictsDSMList = Range("E11:E" & Cells(Rows.Count, "E").End(xlUp).Row)
    Set WBMaster = ActiveWorkbook
    Period = Range("C6").Value
    YYYY = Range("C8").Value
    wsExists = False

    For Each DistrictDSM In DistrictsDSMList.Cells

        Workbooks.Open Filename:="H:\Accounting\Monthend " & YYYY & "\DSM Files\DSM Master Reports\" & DistrictDSM & ".xlsx"
        Set DistMaster = ActiveWorkbook
        wsCount = Application.Sheets.Count

        Path = "H:\Accounting\Monthend " & YYYY & "\DSM Files\" & DistrictDSM & "\P02"
        DistPeriodFile = Dir(Path & "\*.xlsx")

        Do While DistPeriodFile <> ""

            Workbooks.Open Filename:=Path & "\" & DistPeriodFile, UpdateLinks:=False
            DistPeriodFile = Dir
            Set CurDstTerrFile = ActiveWorkbook
            Territory = CurDstTerrFile.Sheets("Index").Range("A3").Value

            For x = 1 To wsCount
                If DistMaster.Worksheets(x).name = Territory Then
                    CurDstTerrFile.Sheets("Index").Range("F20").Copy 'PM
                    DistMaster.Sheets(Territory).Activate
                    Range("C3").PasteSpecial Paste:=xlPasteValues

                    CurDstTerrFile.Sheets("Index").Range("J20").Copy 'XRA
                    DistMaster.Sheets(Territory).Activate
                    Range("C5").PasteSpecial Paste:=xlPasteValues

                    CurDstTerrFile.Sheets("Index").Range("N20").Copy 'CO-OP
                    DistMaster.Sheets(Territory).Activate
                    Range("C7").PasteSpecial Paste:=xlPasteValues

                    CurDstTerrFile.Sheets("Index").Range("S20").Copy 'VR
                    DistMaster.Sheets(Territory).Activate
                    Range("C9").PasteSpecial Paste:=xlPasteValues

                    CurDstTerrFile.Sheets("Index").Range("W20").Copy 'OVER & ABOVE
                    DistMaster.Sheets(Territory).Activate
                    Range("C11").PasteSpecial Paste:=xlPasteValues

                    CurDstTerrFile.Sheets("Index").Range("AA20").Copy 'SS
                    DistMaster.Sheets(Territory).Activate
                    Range("C13").PasteSpecial Paste:=xlPasteValues

                    CurDstTerrFile.Sheets("Index").Range("A3:D19").Copy 'COPY BTs by DISTRICT
                    WBMaster.Sheets("BTs by District").Activate
                    Range("A1000000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues

                    Exit For
                End If
            Next x

            If wsExists = False Then             '***********FIX THIS SECTION!!!*************************
                Worksheets.Add after:=DistMaster.Worksheets(Worksheets.Count)

                CurDstTerrFile.Sheets("Index").Range("A3").Copy 'COPY TERRITORY
                ActiveSheet.name = "New Territory"
                DistMaster.Sheets(Territory).Activate
                Range("A1").PasteSpecial Paste:=xlPasteValues
            End If

            Dim WS As Worksheet, SheetXXX As Worksheet
            Set WS = WBMaster.Sheets("ReptTemplate")
            WS.Copy after:=Sheets(WBMaster.Sheets.Count)

            Set SheetXXX = ActiveWorkbook.ActiveSheet
            SheetXXX.name = Worksheets("ReptTemplate").Range("A1").Value
            CurDstTerrFile.Close

        Loop

        Dim DistWS As Worksheet
        Dim DistName As String
        Dim wbNew As Workbook

        DistName = Left(DistrictDSM, 6) & "*"
        Set wbNew = Application.Workbooks.Add

        For Each DistWS In WBMaster.Sheets
            If DistWS.name Like DistName Then DistWS.Move after:=Sheets(wbNew.Sheets.Count)
        Next DistWS

        With wbNew
            .SaveAs "H:\Accounting\Monthend " & YYYY & "\DSM Files\DSM Master Reports\" & DistrictDSM & ".xlsx"
            .Close
        End With

    Next DistrictDSM

    Application.EnableEvents = True

End Sub

Answer 1

很抱歉，我不能发表评论（没有足够的声誉来评论问题），否则我会在发布之前问几个问题。

据我了解。您需要的是一种逻辑/算法，用于在开始向主文件复制过程之前检查是否需要将新工作表（新区域）添加到主文件中。如果需要添加工作表，则应在主文件末尾添加。

下面的代码是通用代码，但您应该能够轻松地对其进行调整以适应您的目的。下面的代码比较了 wb2 和 wb1 中的工作表。如果 wb2 中的工作表名称在 wb1 中不存在，它将被添加到 wb1 末尾的新工作表，其名称类似于wb2中的那个。

此代码应在打开两个文件后立即放置。

Sub Comapre_Sheets()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim bWorkSheet_Found As Boolean

Set wb1 = Workbooks("Book1") ''' Change this to the master file
Set wb2 = Workbooks("Book2") ''' Change this to the file that might have the new sheet/territory 

For Each wks2 In wb2.Worksheets

    bWorkSheet_Found = False

    For Each wks1 In wb1.Worksheets

        If wks1.name = wks2.name Then
            bWorkSheet_Found = True
        End If

    Next wks1

    If Not bWorkSheet_Found Then
        wb1.Worksheets.Add(After:=Worksheets(wb1.Sheets.Count)).name = wks2.name
    End If

Next wks2

End Sub

希望对你有帮助