VBA code if worksheet does not exist go to next file

[hvl888]

Hi all,

Hoping someone can help.

The code below is used to append all data from various workbooks into a single master worksheet. This works fine when all the workbooks being appended contain the worksheet in question but runs into an error if a workbook does not contain the specific worksheet which is sometime the case. I would like the macro to run through the process and move on to the next file if the worksheet does not exist in the current workbook.

Any help would be greatly appreciated.

Thank you

Sub Append_data_Overtime()

Dim folderpath As String, filepath As String, filename As String

folderpath = Worksheets("Menu").Range("C2") & "\"

filepath = folderpath & "*.xls*"

filename = Dir(filepath)

Dim lastrow As Long, lastcolumn As Long

Do While filename <> ""
Workbooks.Open (folderpath & filename)

Worksheets("OvertimeByPost").Select

Rows("1:4").Select
Selection.Delete Shift:=xlUp
lastrow = Worksheets("OvertimeByPost").Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = Worksheets("OvertimeByPost").Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close

erow = Worksheets("OvertimeByPost").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets("OvertimeByPost").Select
ActiveSheet.Paste Destination:=Worksheets("OvertimeByPost").Range(Cells(erow, 1), Cells(erow, 14))

filename = Dir

Loop

Application.DisplayAlerts = True


End Sub

 

[HaHoBe]

Hi jvl888,

maybe try this code

Sub Append_data_Overtime_02()
'https://www.mrexcel.com/board/threads/vba-code-if-worksheet-does-not-exist-go-to-next-file.1171018/

  Dim folderpath As String, filepath As String, filename As String
  Dim lastrow As Long, lastColumn As Long
  Dim wksTarget As Worksheet
  
  Set wksTarget = ThisWorkbook.Worksheets("OvertimeByPost")
  
  folderpath = Worksheets("Menu").Range("C2") & "\"
  filepath = folderpath & "*.xls*"
  filename = Dir(filepath)
  
  Do While filename <> ""
    Workbooks.Open (folderpath & filename)
    If Evaluate("ISREF('OvertimeByPost'!A1)") Then
      erow = wksTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
      With Worksheets("OvertimeByPost")
        .Rows("1:4").Delete Shift:=xlUp
        lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
        lastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
        .Range(Cells(2, 1), Cells(lastrow, lastColumn)).Copy
        Application.DisplayAlerts = False
        wksTarget.Range(wksTarget.Cells(erow, 1), wksTarget.Cells(erow, 14)).Paste
        .Close
      End With
    End If
    
    filename = Dir
  
  Loop
  
  Set wksTarget = Nothing
  
  Application.DisplayAlerts = True


End Sub

Ciao,
Holger

 

[hvl888]

Hi Holger,

Thanks for this, however, i get the following error. There are a number worksheets in each workbook, some do not contain the 'overtimebypost' worksheet

 

[HaHoBe]

Hi hvl888,

my bad, please try changing the offending codeline to

        .Range(.Cells(2, 1), .Cells(lastrow, lastColumn)).Copy

by adding a dot before Cells.

Ciao,
Holger

 

[Snakehips]

Not tested but maybe....

Sub Append_data_Overtime()

Dim folderpath As String, filepath As String, filename As String

folderpath = Worksheets("Menu").Range("C2") & "\"

filepath = folderpath & "*.xls*"

filename = Dir(filepath)

Dim lastrow As Long, lastcolumn As Long

Do While filename <> ""
Workbooks.Open (folderpath & filename)
On Error Resume Next  '<<<<<Ignore errors
Worksheets("OvertimeByPost").Select
If Err.Number = 0 Then  '<<<< if sheet exists then error is 0 so do stuff below
Rows("1:4").Select
Selection.Delete Shift:=xlUp
lastrow = Worksheets("OvertimeByPost").Cells(Rows.Count, 1).End(xlUp).row
lastcolumn = Worksheets("OvertimeByPost").Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close

erow = Worksheets("OvertimeByPost").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row
Worksheets("OvertimeByPost").Select
ActiveSheet.Paste Destination:=Worksheets("OvertimeByPost").Range(Cells(erow, 1), Cells(erow, 14))

filename = Dir
End If
On Error GoTo 0   '<<< reset error handling to default
Loop

Application.DisplayAlerts = True


End Sub

 

[HaHoBe]

Hi Snakehips,

correct me but shouldn´t the line

filename = Dir

be placed outside the If? In any case there should be a new workbook or none if the loop is through?

Ciao,
Holger

 

[Snakehips]

Hi Snakehips,

correct me but shouldn´t the line

filename = Dir

be placed outside the If? In any case there should be a new workbook or none if the loop is through?

Ciao,
Holger

YES! Absolutely. Well spotted, I was a tad careless.

 

[hvl888]

Thank you both for your suggestions, however, neither approach seems to work.

 

[HaHoBe]

Hi hvl888,

I made up a sample to test (I copied the values over instead using Copy/Paste) and it worked for me with this code:

Sub Append_data_Overtime_03()
'https://www.mrexcel.com/board/threads/vba-code-if-worksheet-does-not-exist-go-to-next-file.1171018/

  Dim FolderPath As String, FilePath As String, FileName As String, eRow As Long
  Dim lastRow As Long, lastColumn As Long
  Dim wksTarget As Worksheet
  
  Const cstrWS As String = "OvertimeByPost"
  
  Set wksTarget = ThisWorkbook.Worksheets(cstrWS)
  
  FolderPath = ThisWorkbook.Worksheets("Menu").Range("C2") & "\"
  FilePath = FolderPath & "*.xls*"
  FileName = Dir(FilePath)
  
  Do While FileName <> ""
    Workbooks.Open (FolderPath & FileName)
    If Evaluate("ISREF('" & cstrWS & "'!A1)") Then
      eRow = wksTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
      With Worksheets(cstrWS)
        .Rows("1:4").Delete Shift:=xlUp
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        lastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
        Application.DisplayAlerts = False
        With .Range(.Cells(2, 1), .Cells(lastRow, lastColumn))
          wksTarget.Cells(eRow, 1).Resize(lastRow - 1, lastColumn).Value = .Value
        End With
      End With
    End If
    ActiveWorkbook.Close False
    FileName = Dir
  
  Loop
  
  Set wksTarget = Nothing
  
  Application.DisplayAlerts = True


End Sub

Ciao,
Holger

 

[hvl888]

Hi hvl888,

I made up a sample to test (I copied the values over instead using Copy/Paste) and it worked for me with this code:

Sub Append_data_Overtime_03()
'https://www.mrexcel.com/board/threads/vba-code-if-worksheet-does-not-exist-go-to-next-file.1171018/

  Dim FolderPath As String, FilePath As String, FileName As String, eRow As Long
  Dim lastRow As Long, lastColumn As Long
  Dim wksTarget As Worksheet
 
  Const cstrWS As String = "OvertimeByPost"
 
  Set wksTarget = ThisWorkbook.Worksheets(cstrWS)
 
  FolderPath = ThisWorkbook.Worksheets("Menu").Range("C2") & "\"
  FilePath = FolderPath & "*.xls*"
  FileName = Dir(FilePath)
 
  Do While FileName <> ""
    Workbooks.Open (FolderPath & FileName)
    If Evaluate("ISREF('" & cstrWS & "'!A1)") Then
      eRow = wksTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
      With Worksheets(cstrWS)
        .Rows("1:4").Delete Shift:=xlUp
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        lastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
        Application.DisplayAlerts = False
        With .Range(.Cells(2, 1), .Cells(lastRow, lastColumn))
          wksTarget.Cells(eRow, 1).Resize(lastRow - 1, lastColumn).Value = .Value
        End With
      End With
    End If
    ActiveWorkbook.Close False
    FileName = Dir
 
  Loop
 
  Set wksTarget = Nothing
 
  Application.DisplayAlerts = True


End Sub

Ciao,
Holger

Thank you @HaHoBe this worked perflectly! very much appreciated