VBA loop with wildcard in Sheet name

[Pdunne]

Hi All,

I'm pretty new to VBA, this is my also my first time posting on here. Hoping somebody can help me tweak my code;
The code loops through all the files in a folder to copy data from a sheet called ("P&L 2019 - UK GAAP") into one workbook.
The issue that I'm having is that, a couple of the workbooks have not named the sheet ("P&L 2019 - UK GAAP")......

The sheet name will start with P&L so I'm looking for some kind of wildcard, or partial match lookup...
But there is another sheet called "P&L 2019 - US GAAP" withing the workbook, which I want to avoid picking up.

Any help on this would be great!


Sub Template_Consol()


Dim myfile As String
Dim q As Long
q = 1
Dim filepath As String
Dim noWbs As Byte


'This picks up the number of workbooks from the input cell
noWbs = Sheets("inputs for Macro").Range("b3")


'Pick filepath from cell B3 in tab called "Inputs for Macro"
filepath = Sheets("Inputs for Macro").Range("b2")


'Add backslash to the end of the filepath name so that we have the correct syntax in order to concatenate the file name onto the end of this
If Right(filepath, 1) <> "" Then filepath = filepath & ""


Application.ScreenUpdating = False
myfile = Dir(filepath)
Do While Len(myfile) > 0
Workbooks.Open (filepath & myfile)


'Update Sheet name if I want to pull form another sheet
Worksheets("P&L 2019 - UK GAAP").Activate
ActiveSheet.UsedRange.Copy
ActiveWorkbook.Close Save = False


'This should stop excel from asking me about large amount of data on clipboard
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False


Sheets(q).Select
ActiveSheet.Paste Destination:=Worksheets(q).Range("A1")
Application.CutCopyMode = False
q = q + 1


'Number of files is pulled from the input sheet in this workbook


If q > noWbs + 1 Then
Exit Sub
End If
myfile = Dir
Loop
ActiveWorkbook.Save
Application.ScreenUpdating = True




End Sub

 

[DanteAmor]

Try this

Sub Template_Consol()
  Dim myfile As String, q As Long, filepath As String, noWbs As Byte, wb As Workbook, sh As Worksheet
  '
  Application.ScreenUpdating = False
  Application.AskToUpdateLinks = False
  Application.DisplayAlerts = False
  '
  q = 1
  noWbs = Sheets("inputs for Macro").Range("b3")              'This picks up the number of workbooks from the input cell
  filepath = Sheets("Inputs for Macro").Range("b2")           'Pick filepath from cell B3
  If Right(filepath, 1) <> "\" Then filepath = filepath & "\" 'Add backslash to the end of the filepath
  myfile = Dir(filepath)
  Do While Len(myfile) > 0
    Set wb = Workbooks.Open(filepath & myfile)
    For Each sh In wb.Sheets
[COLOR=#0000ff]      If UCase(Left(sh.Name, 3)) = UCase("P&L") Then          'The sheet name will start with P&L[/COLOR]
        sh.UsedRange.Copy ThisWorkbook.Sheets(q).Range("A1")
        q = q + 1
        If q > noWbs + 1 Then Exit Sub                        'Number of files is pulled
      End If
    Next
    wb.Close False
    myfile = Dir
  Loop
  ActiveWorkbook.Save
End Sub

 

[Pdunne]

Thank you for this Dante!

Can I ask you to change it a little for me? I need to ask it not to copy in the sheet name with P&L 2019 - US GAAP...
I've tried adding an and to the if statement

If UCase(Left(sh.Name, 3)) = UCase("P&L") And sh.Name <> "*US*" Then

But it is not working

This code pastes links to the last file, is it possible to drop in the code to break the links? Or just paste values and format.

Any help much appreciated!
Kind regards,
Paula

Try this

Sub Template_Consol()
  Dim myfile As String, q As Long, filepath As String, noWbs As Byte, wb As Workbook, sh As Worksheet
  '
  Application.ScreenUpdating = False
  Application.AskToUpdateLinks = False
  Application.DisplayAlerts = False
  '
  q = 1
  noWbs = Sheets("inputs for Macro").Range("b3")              'This picks up the number of workbooks from the input cell
  filepath = Sheets("Inputs for Macro").Range("b2")           'Pick filepath from cell B3
  If Right(filepath, 1) <> "\" Then filepath = filepath & "\" 'Add backslash to the end of the filepath
  myfile = Dir(filepath)
  Do While Len(myfile) > 0
    Set wb = Workbooks.Open(filepath & myfile)
    For Each sh In wb.Sheets
[COLOR=#0000ff]      If UCase(Left(sh.Name, 3)) = UCase("P&L") Then          'The sheet name will start with P&L[/COLOR]
        sh.UsedRange.Copy ThisWorkbook.Sheets(q).Range("A1")
        q = q + 1
        If q > noWbs + 1 Then Exit Sub                        'Number of files is pulled
      End If
    Next
    wb.Close False
    myfile = Dir
  Loop
  ActiveWorkbook.Save
End Sub

 

[gallen]

If I understand correctly: you just need to check that the string value isn't contained in the sheet name:

    For Each sh In wb.Sheets
[COLOR=#ff0000]        If InStr(1, wb.Name, "P&L 2019 - US GAAP") = 0 Then[/COLOR]
            If UCase(Left(sh.Name, 3)) = UCase("P&L") Then          'The sheet name will start with P&L
              sh.UsedRange.Copy ThisWorkbook.Sheets(q).Range("A1")
              q = q + 1
              If q > noWbs + 1 Then Exit Sub                        'Number of files is pulled
            End If
[COLOR=#ff0000]        End If[/COLOR]
    Next

 

[Pdunne]

Thank you for this Gallen. I've dropped in that line of code, and I'm getting the error "Next without for"

Any ideas?

If I understand correctly: you just need to check that the string value isn't contained in the sheet name:

    For Each sh In wb.Sheets
[COLOR=#ff0000]        If InStr(1, wb.Name, "P&L 2019 - US GAAP") = 0 Then[/COLOR]
            If UCase(Left(sh.Name, 3)) = UCase("P&L") Then          'The sheet name will start with P&L
              sh.UsedRange.Copy ThisWorkbook.Sheets(q).Range("A1")
              q = q + 1
              If q > noWbs + 1 Then Exit Sub                        'Number of files is pulled
            End If
[COLOR=#ff0000]        End If[/COLOR]
    Next

 

[DanteAmor]

Thank you for this Dante!

(1) If UCase(Left(sh.Name, 3)) = UCase("P&L") And sh.Name <> "*US*" Then

(2) This code pastes links to the last file, is it possible to drop in the code to break the links? Or just paste values and format.

Try this

Sub Template_Consol()
  Dim myfile As String, q As Long, filepath As String, noWbs As Byte, wb As Workbook, sh As Worksheet
  '
  Application.ScreenUpdating = False
  Application.AskToUpdateLinks = False
  Application.DisplayAlerts = False
  '
  q = 1
  noWbs = Sheets("inputs for Macro").Range("b3")              'This picks up the number of workbooks from the input cell
  filepath = Sheets("Inputs for Macro").Range("b2")           'Pick filepath from cell B3
  If Right(filepath, 1) <> "\" Then filepath = filepath & "\" 'Add backslash to the end of the filepath
  myfile = Dir(filepath)
  Do While Len(myfile) > 0
    Set wb = Workbooks.Open(filepath & myfile)
    For Each sh In wb.Sheets
      If InStr(1, UCase(sh.Name), "US") = 0 Then                '[COLOR=#ff0000](1)[/COLOR] Not copy sheet whit US
        If UCase(Left(sh.Name, 3)) = UCase("P&L") Then          'The sheet name will start with P&L
          sh.UsedRange.Copy
          ThisWorkbook.Sheets(q).Range("A1").PasteSpecial xlPasteValues   [COLOR=#0000ff]'(2)[/COLOR]
          ThisWorkbook.Sheets(q).Range("A1").PasteSpecial xlPasteFormats
          q = q + 1
          If q > noWbs + 1 Then Exit Sub                        'Number of files is pulled
        End If
      End If
    Next
    wb.Close False
    myfile = Dir
  Loop
  ActiveWorkbook.Save
End Sub

 

[Pdunne]

Thanks Dante, this code is giving me an error...
"object variable or with block variable not set"
Any ideas?

Kind regards,

Paula.

Try this

Sub Template_Consol()
  Dim myfile As String, q As Long, filepath As String, noWbs As Byte, wb As Workbook, sh As Worksheet
  '
  Application.ScreenUpdating = False
  Application.AskToUpdateLinks = False
  Application.DisplayAlerts = False
  '
  q = 1
  noWbs = Sheets("inputs for Macro").Range("b3")              'This picks up the number of workbooks from the input cell
  filepath = Sheets("Inputs for Macro").Range("b2")           'Pick filepath from cell B3
  If Right(filepath, 1) <> "\" Then filepath = filepath & "\" 'Add backslash to the end of the filepath
  myfile = Dir(filepath)
  Do While Len(myfile) > 0
    Set wb = Workbooks.Open(filepath & myfile)
    For Each sh In wb.Sheets
      If InStr(1, UCase(sh.Name), "US") = 0 Then                '[COLOR=#ff0000](1)[/COLOR] Not copy sheet whit US
        If UCase(Left(sh.Name, 3)) = UCase("P&L") Then          'The sheet name will start with P&L
          sh.UsedRange.Copy
          ThisWorkbook.Sheets(q).Range("A1").PasteSpecial xlPasteValues   [COLOR=#0000ff]'(2)[/COLOR]
          ThisWorkbook.Sheets(q).Range("A1").PasteSpecial xlPasteFormats
          q = q + 1
          If q > noWbs + 1 Then Exit Sub                        'Number of files is pulled
        End If
      End If
    Next
    wb.Close False
    myfile = Dir
  Loop
  ActiveWorkbook.Save
End Sub

 

[DanteAmor]

Thanks Dante, this code is giving me an error...
"object variable or with block variable not set"
Any ideas?

Kind regards,

Paula.

The macro works for me.
Did you modify some of the macro?
On which line does it stop or which line is marked?

 

[Pdunne]

Your right I must have modified it, I've re-pasted that and its working fine for me now.

Thank you so much for your help! Much appreciated

The macro works for me.
Did you modify some of the macro?
On which line does it stop or which line is marked?

 

[DanteAmor]

Your right I must have modified it, I've re-pasted that and its working fine for me now.

Thank you so much for your help! Much appreciated

I'm glad to help you. Thanks for the feedback.