工作表複製到另一個工作簿，而不復制工作表

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

，你可以使用一個輔助功能，如以下

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 

Answer 2

不使用sheet.Name。使用工作表（指數）找出你想要的工作簿。 IST更安全，你一定會複製一個接一個（避免雙重拷貝）。