Excel VBA在將工作表復制到工作簿之前檢查工作表是否存在

Question

我正在嘗試開發一個宏，如果該工作表不存在於主工作簿中，則該宏可以從文件夾中的所有工作簿中提取所有工作表。 IE瀏覽器

Folder  
|---Summary Sheet.xlsm  
|---Sheet 1 date1.xlsx  
|---Sheet 2 date2.xlsx   
etc.

宏將打開工作簿，將工作表重命名為單元格中的日期，將其復制后再關閉而不保存/提示。 我似乎無法正確合並名稱檢查。 我看過了
測試或檢查表是否存在
如果存在WorkSheet（“ wsName”），則為Excel VBA
但是缺乏適當翻譯概念的經驗。

到目前為止，這是代碼。 現在運行會引發運行時錯誤438
sheetToFind = ThisWorkbook.Sheets（1）

Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Dim sheetToFind As String
Dim sheetExists As Boolean

Application.ScreenUpdating = False
Application.DisplayAlerts = False

FolderPath = Environ("userprofile") & "\Folder\"
Filename = Dir(FolderPath & "*.xlsx")

 Do While Filename <> ""
 Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
 sheetExists = False

 For Each Sheet In ActiveWorkbook.Sheets
   Sheet.Name = Sheet.Range("C4")
   sheetToFind = ThisWorkbook.Sheets(1)
   If sheetToFind = Sheet.Name Then
     sheetExists = True
   End If

   If sheetExists = False Then
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
     Workbooks(Filename).Close False
     Filename = Dir()
   End If
  Next Sheet
Loop
Application.ScreenUpdating = True
End Sub

Answer 1

我上面回答的問題是他們沒有每次都檢查每張紙。 我發現了另一個功能
如果存在WorkSheet（“ wsName”），則為Excel VBA

使用它，我能夠使一切正常。

Function sheetExists(sheetToFind As String) As Boolean
    sheetExists = False
    For Each Sheet In ThisWorkbook.Worksheets
        If sheetToFind = Sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next Sheet
End Function

Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
FolderPath = Environ("userprofile") & "\Folder\"
Filename = Dir(FolderPath & "*.xlsx")

Do While Filename <> ""
  Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
  For Each Sheet In ActiveWorkbook.Sheets
    Sheet.Name = Sheet.Range("C4")
    result = sheetExists(Sheet.Name)
    Debug.Print result
    If result = True Then
      Workbooks(Filename).Close False
      Filename = Dir()
    End If
    If result = False Then
      Sheet.Copy After:=ThisWorkbook.Sheets(1)
      Workbooks(Filename).Close False
      Filename = Dir()
    End If
  Next Sheet
Loop
Application.ScreenUpdating = True
End Sub