Question

我是VBA的新人，请耐心等待。我试图将工作表从指定的文件位置复制到主合并工作簿中。我想防止将重复的工作表复制到合并的工作簿中。例如，如果工作表1已复制到主合并工作簿中，我不想在命令运行时重新复制它。下面是我到目前为止的代码。

Private Sub CommandButton1_Click()

Dim directory As String
Dim fileName As String
Dim sheet As Worksheet
Dim total As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = "c:\test\"
' edit directory

fileName = Dir(directory & "*.xl??")

Do While fileName <> ""
Workbooks.Open (directory & fileName)

For Each sheet In Workbooks(fileName).Worksheets
    total = Workbooks("test import.xlsm").Worksheets.Count
    Workbooks(fileName).Worksheets(sheet.Name).Copy _
    after:=Workbooks("test import.xlsm").Worksheets(total)
Next sheet

Workbooks(fileName).Close

fileName = Dir()

Loop


Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Answer 1

请勿使用 sheet.Name 。使用工作表（索引）来标识所需的工作簿。我更安全，你一定要一个一个地复制（避免双重复制）。

Answer 2

你可以使用如下的帮助函数

Function IsSheetFree(wb As Workbook, shtName As String) As Boolean
    Dim sht As Worksheet

    On Error Resume Next '<--| prevent any subsequent error to stop the function
    Set sht = wb.Worksheets(shtName) '<--| try setting 'sht' worksheet object to the one with passed name in the passed workbook
    IsSheetFree = sht Is Nothing '<--| return 'True' if 'sht' has not been successfully set
End Function

并按如下方式利用它：

Private Sub CommandButton1_Click()

    Dim directory As String
    Dim fileName As String
    Dim sht As Worksheet

    Dim totalWb As Workbook

    Set totalWb = Workbooks("test import.xlsm")

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    directory = "c:\test\"
    ' edit directory

    fileName = Dir(directory & "*.xl??")

    Do While fileName <> ""
        Workbooks.Open directory & fileName '<--| this makes the just opened workbook the "active" one

        For Each sht In Worksheets '<--| loop through currently active workbook worksheets
            If IsSheetFree(totalWb, sht.Name) Then sht.Copy after:=totalWb.Worksheets(totalWb.Worksheets.Count)
        Next sht

        ActiveWorkbook.Close

        fileName = Dir()
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

将工作表复制到另一个工作簿而不复制工作表

2 个答案: