CODEWITHSUNDEEP
vbaexcel
Virtmald
Virtmald

Reputation: 1

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 

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
But lack the experience to properly translate the concepts across.

This is the code so far. Running now throws a runtime error 438 with
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

Upvotes: 0

Views: 6799

Answers (1)

Virtmald
Virtmald

Reputation: 1

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

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

Upvotes: 0

Related Questions