首页 文章

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

提问于
浏览 次
0

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

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

宏打开工作簿，将工作表重命名为单元格的日期，将其复制，然后关闭它而不保存/提示 . 我可以't seem to incorporate the name check correctly. I'看了看
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
excel vba excel-vba

1 回答

  • 0

    我面对上述答案的问题是他们每次都没有检查每张纸 . 我发现了另一个功能
    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
    回复于

相关问题