简体   繁体   English

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

[英]Excel VBA Check if worksheet exists before copy worksheet to workbook a

I'm trying develop a macro that pulls in all sheets from all workbooks in a folder if that worksheet doesn't already exist in the master workbook. 我正在尝试开发一个宏,如果该工作表不存在于主工作簿中,则该宏可以从文件夹中的所有工作簿中提取所有工作表。 IE IE浏览器

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

The macro opens the workbook, renames the sheet to the date off a cell, copies it across then closes it without saving/prompting. 宏将打开工作簿,将工作表重命名为单元格中的日期,将其复制后再关闭而不保存/提示。 I can't seem to incorporate the name check correctly. 我似乎无法正确合并名称检查。 I've looked over 我看过了
Test or check if sheet exists 测试或检查表是否存在
Excel VBA If WorkSheet("wsName") Exists 如果存在WorkSheet(“ wsName”),则为Excel VBA
But lack the experience to properly translate the concepts across. 但是缺乏适当翻译概念的经验。

This is the code so far. 到目前为止,这是代码。 Running now throws a runtime error 438 with 现在运行会引发运行时错误438
sheetToFind = ThisWorkbook.Sheets(1) 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

The problem I faced with the answers above were that they didn't check each sheet each time. 我上面回答的问题是他们没有每次都检查每张纸。 I found another function from 我发现了另一个功能
Excel VBA If WorkSheet("wsName") Exists 如果存在WorkSheet(“ wsName”),则为Excel VBA

Using that I was able to make everything work. 使用它,我能够使一切正常。

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM