Question

我正在尝试开发一个宏来从文件夹中的所有工作簿中提取所有工作表，如果该工作表在主工作簿中不存在的话。 IE

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

宏打开工作簿，将工作表重命名为单元格之外的日期，将其复制，然后关闭它而不保存/提示。我似乎无法正确地加入名称检查。我看过了 Test or check if sheet exists
Excel VBA If WorkSheet("wsName") Exists
但缺乏正确翻译概念的经验。

这是到目前为止的代码。现在运行会抛出运行时错误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

我面对上述答案的问题是他们每次都没有检查每张纸。我发现了另一个功能 Excel VBA If WorkSheet("wsName") Exists

使用它我能使一切运转起来。

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

Excel VBA检查复制工作表之前是否存在工作表到工作簿a

1 个答案: