Question

我的代码是合并文件夹中的多个工作表。我实现了第一个合并目标工作簿的所有sheet1的要求。但现在，我想合并第4张目标工作簿。在此之前，我需要检查工作表是否存在。如果存在，代码应合并第4张。这也是我设法实现的。但是，如果第4张表不存在，则代码应该不执行任何操作。这部分我还是卡住了。下面是代码。

Set shtDest = ActiveWorkbook.Sheets("MS2")
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
    If Not Filename = ThisWB Then
        Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
        For i = 1 To Worksheets.Count
        If Worksheets(i).Name = "PID2" Then
        Wkb.Sheets(4).Activate
        Set CopyRng = Wkb.Sheets(4).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
        Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row)
        CopyRng.Copy Dest
        Wkb.Close False
        "ElseIf Worksheets(i).Name <> "PID2" Then"
        "Wkb.Close False"
        "Exit Sub"
        End If
        Next i
    End If

    Filename = Dir()
Loop

Answer 1

假设PID2是您要复制的第四张纸（如果存在）

Sub t()
    Set shtDest = ActiveWorkbook.Sheets("MS2")
    Filename = Dir(Path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub

    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(Filename:=Path & "\" & Filename)

            For i = 1 To Worksheets.Count
                If Worksheets(i).Name = "PID2" Then
                    Worksheets(i).Activate
                    Set CopyRng = Worksheets(i).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
                    Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row)
                    CopyRng.Copy Dest
                End If
            Next i

            Wkb.Close False
        End If

        Filename = Dir()
    Loop
End Sub

Answer 2

所需代码的PFA，我在代码中做了一些修改。

    Set shtDest = ActiveWorkbook.Sheets("MS2")

Filename = Dir(Path & "\*.xls", vbNormal)

If Len(Filename) = 0 Then Exit Sub

Do Until Filename = vbNullString

    If Not Filename = ThisWB Then

        Set Wkb = Workbooks.Open(Filename:=Path & "\" & Filename)

        For i = 1 To Worksheets.Count

            If Worksheets(i).Name = "PID2" Then

                Wkb.Sheets(i).Activate
                Set CopyRng = Range(Cells(RowofCopySheet, 1), ActiveCell.SpecialCells(xlCellTypeLastCell))
                Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row)
                CopyRng.Copy Dest

                Exit For

            End If
        Next i

        Wkb.Close False

    End If

    Filename = Dir()
Loop

Answer 3

您需要指定一些条件，然后在此之后退出，

即

If something = <criteria> Then
   goto exitsub
end if

exitsub:

这将使用您指定的字符串末尾的exitsub跳转到: exitsub:您可以将其设为任意内容，例如goToEndOfSub:

If something = <criteria> Then
      goto goToEndOfSub
end if

goToEndOfSub:

另外，您可以使用Exit Statement，在您的情况下使用do循环。

Exit Do

Excel VBA - 如果找不到工作表，如何退出代码

3 个答案: