许多工作簿合并

Question

你好，我在第 21 行的下面的宏有问题，

• worksheets.add.name = shtname

在我看来，一旦结束第一个循环，它就不会改变 shtname 字符串的值 我想知道发生了什么是代码：

Sub lsConsolidarPlanilhas()

Dim lWorkbook           As Workbooks
Dim lWorksheet          As Worksheet
Dim lUltimaLinhaAtiva   As Long
Dim lControle           As Long
Dim lUltimaLinhaAtiva2  As Long
Dim lUltimaLinhaAtiva3  As Long
Dim lUltimaLinhaAtiva4  As Long
Dim shtname             As String

Application.DisplayAlerts = False
Application.ScreenUpdating = False

lUltimaLinhaAtiva = Worksheets("Configuração").Cells(Worksheets("Configuração").Rows.Count, 1).End(xlUp).Row
lControle = 2

While lControle <= lUltimaLinhaAtiva

    If (Workbooks("Macros.xlsm").Worksheets("Configuração").Range("B" & lControle).Value <> "") Then
    shtname = Range("B" & lControle).Text
    Worksheets.Add.name = shtname
    End If

    If (Workbooks("Macros.xlsm").Worksheets("Configuração").Range("B" & lControle).Value <> "") Then

    Workbooks.Open Filename:=Worksheets("Configuração").Range("A" & lControle).Value

        Set lworkbooks = ActiveWorkbook

                If (ActiveWorkbook.Sheets.Count > 1) Then

                Workbooks(lworkbooks.name).Worksheets("<LVC>").Activate
                lUltimaLinhaAtiva2 = Worksheets("<LVC>").Cells(Worksheets("<LVC>").Rows.Count, 1).End(xlUp).Row
                Worksheets("<LVC>").Select
                Worksheets("<LVC>").Range("A1:AI18").Select
                Selection.Copy

                lUltimaLinhaAtiva3 = Workbooks("Macros.xlsm").Worksheets(shtname).Cells(Workbooks("Macros.xlsm").Worksheets(shtname).Rows.Count, 1).End(xlUp).Row + 1
                Workbooks("Macros.xlsm").Worksheets(shtname).Activate
                Workbooks("Macros.xlsm").Worksheets(shtname).Range("A" & lUltimaLinhaAtiva3).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

                For i = 1 To ActiveWorkbook.Sheets.Count

                Workbooks(lworkbooks.name).Worksheets(i).Activate
                lUltimaLinhaAtiva2 = Worksheets(i).Cells(Worksheets(i).Rows.Count, 1).End(xlUp).Row
                Worksheets(i).Select
                Worksheets(i).Range("A19:AI" & lUltimaLinhaAtiva2).Select
                Selection.Copy

                lUltimaLinhaAtiva4 = Workbooks("Macros.xlsm").Worksheets(shtname).Cells(Workbooks("Macros.xlsm").Worksheets(shtname).Rows.Count, 1).End(xlUp).Row + 1
                Workbooks("Macros.xlsm").Worksheets(shtname).Activate
                Workbooks("Macros.xlsm").Worksheets(shtname).Range("A" & lUltimaLinhaAtiva4).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

                Next

                End If

                Workbooks(lworkbooks.name).Worksheets("<LVC>").Activate
                lUltimaLinhaAtiva2 = Worksheets("<LVC>").Cells(Worksheets("<LVC>").Rows.Count, 1).End(xlUp).Row
                Worksheets("<LVC>").Select
                Worksheets("<LVC>").Range("A1:AI" & lUltimaLinhaAtiva2).Select
                Selection.Copy

                lUltimaLinhaAtiva3 = Workbooks("Macros.xlsm").Worksheets(shtname).Cells(Workbooks("Macros.xlsm").Worksheets(shtname).Rows.Count, 1).End(xlUp).Row + 1
                Workbooks("Macros.xlsm").Worksheets(shtname).Activate
                Workbooks("Macros.xlsm").Worksheets(shtname).Range("A" & lUltimaLinhaAtiva3).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    Else:

    Workbooks.Open Filename:=Worksheets("Configuração").Range("A" & lControle).Value

        Set lworkbooks = ActiveWorkbook

                If (ActiveWorkbook.Sheets.Count > 1) Then

                For i = 1 To ActiveWorkbook.Sheets.Count

                Workbooks(lworkbooks.name).Worksheets(i).Activate
                lUltimaLinhaAtiva2 = Worksheets(i).Cells(Worksheets(i).Rows.Count, 1).End(xlUp).Row
                Worksheets(i).Select
                Worksheets(i).Range("A19:AI" & lUltimaLinhaAtiva2).Select
                Selection.Copy

                lUltimaLinhaAtiva4 = Workbooks("Macros.xlsm").Worksheets(shtname).Cells(Workbooks("Macros.xlsm").Worksheets(shtname).Rows.Count, 1).End(xlUp).Row + 1
                Workbooks("Macros.xlsm").Worksheets(shtname).Activate
                Workbooks("Macros.xlsm").Worksheets(shtname).Range("A" & lUltimaLinhaAtiva4).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

                Next

                End If

                Workbooks(lworkbooks.name).Worksheets("<LVC>").Activate
                lUltimaLinhaAtiva2 = Worksheets("<LVC>").Cells(Worksheets("<LVC>").Rows.Count, 1).End(xlUp).Row
                Worksheets("<LVC>").Select
                Worksheets("<LVC>").Range("A19:AI" & lUltimaLinhaAtiva2).Select
                Selection.Copy

                lUltimaLinhaAtiva3 = Workbooks("Macros.xlsm").Worksheets(shtname).Cells(Workbooks("Macros.xlsm").Worksheets(shtname).Rows.Count, 1).End(xlUp).Row + 1
                Workbooks("Macros.xlsm").Worksheets(shtname).Activate
                Workbooks("Macros.xlsm").Worksheets(shtname).Range("A" & lUltimaLinhaAtiva3).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    End If

    Workbooks(lworkbooks.name).Close

    lControle = lControle + 1

Wend

Worksheets("Configuração").Select
Worksheets("Configuração").Range("A1").Select

Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox "Planilhas consolidadas!"

End Sub

Answer 1

谢谢@Cor_Blimey，这确实是问题所在，一旦我为 shtname 指定了工作簿，它就可以完美运行

“不合格的 Range() 函数隐含地引用了可能不是预期的活动工作表。通过在其前面添加 Workbooks("Macros.xlsm").Worksheets("Configuração"). 使其完全合格。通常，我还建议重构代码以消除所有 .Select 和 .Activate ，而是分配给临时工作表变量，以便透明并清楚正在执行的操作（例如 Set sourceWb = ...Set sourceWs = sourceWb. Worksheets(1)...等 – Cor_Blimey 22 小时前"