import sheet based on partial file name

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
417
Office Version
  1. 2016
Hey Guys,

I have the below. It works, but I need it to import based on a partial filename and I cant seem how to complete it.

Basically I want it to import the sheet if it has the text "Cleared" in it. Its erroring out because some are named Cleared - Cleared to and some are named Cleared-Cleared To ect ect. Any help is greatly appreciated! Based on partial sheet name not partial file name rather!

Jordan

Sub AllFiles()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
folderPath = "C:\Users\jordan.burch.ctr\Desktop\Cert Statements\" 'contains folder path
If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
Filename = Dir(folderPath & "*.xls*")
Do While Filename <> ""

Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & Filename)
Worksheets("Cleared - Cleared To").Range("a2:AU" & Range("A" & Rows.Count).End(xlUp).Row).Copy
Workbooks("Certification statement automation").Worksheets("Cleared").Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
Workbooks(Filename).Close True
Filename = Dir
Loop
applications.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Try replacing:
VBA Code:
Worksheets("Cleared - Cleared To").Range("a2:AU" & Range("A" & Rows.Count).End(xlUp).Row).Copy
with:
VBA Code:
    Dim ws As Worksheet
    Dim ClearedSheet As String
    For Each ws In ActiveWorkbook.Worksheets
        If InStr(1, ws.Name, "Cleared", vbTextCompare) Then
            ClearedSheet = ws.Name
            Exit For
        End If
    Next
    ActiveWorkbook.Worksheets(ClearedSheet).Range("a2:AU" & Range("A" & Rows.Count).End(xlUp).Row).Copy
 
Upvote 0
Try replacing:
VBA Code:
Worksheets("Cleared - Cleared To").Range("a2:AU" & Range("A" & Rows.Count).End(xlUp).Row).Copy
with:
VBA Code:
    Dim ws As Worksheet
    Dim ClearedSheet As String
    For Each ws In ActiveWorkbook.Worksheets
        If InStr(1, ws.Name, "Cleared", vbTextCompare) Then
            ClearedSheet = ws.Name
            Exit For
        End If
    Next
    ActiveWorkbook.Worksheets(ClearedSheet).Range("a2:AU" & Range("A" & Rows.Count).End(xlUp).Row).Copy
awesome John You are a certified GENIUS! now I loop through and discovered a new issue. The sheet may or may not be in the workbook. Can you help me add code to account for if the sheet exists then do the rest and if not move on to the next file?
 
Upvote 0
Insert before the For Each ws loop:
VBA Code:
    ClearedSheet = ""
and replace:
VBA Code:
ActiveWorkbook.Worksheets(ClearedSheet).Range("a2:AU" & Range("A" & Rows.Count).End(xlUp).Row).Copy
Workbooks("Certification statement automation").Worksheets("Cleared").Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
with:
VBA Code:
    If ClearedSheet <> "" Then
        ActiveWorkbook.Worksheets(ClearedSheet).Range("a2:AU" & Range("A" & Rows.Count).End(xlUp).Row).Copy
        Workbooks("Certification statement automation").Worksheets("Cleared").Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
    End If
 
Upvote 0
Insert before the For Each ws loop:
VBA Code:
    ClearedSheet = ""
and replace:
VBA Code:
ActiveWorkbook.Worksheets(ClearedSheet).Range("a2:AU" & Range("A" & Rows.Count).End(xlUp).Row).Copy
Workbooks("Certification statement automation").Worksheets("Cleared").Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
with:
VBA Code:
    If ClearedSheet <> "" Then
        ActiveWorkbook.Worksheets(ClearedSheet).Range("a2:AU" & Range("A" & Rows.Count).End(xlUp).Row).Copy
        Workbooks("Certification statement automation").Worksheets("Cleared").Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
    End If
awesome thanks! One more question it keeps throwing and error code 1004 pastespecial failed? it seems to happen on only certain files and not all files. Any ideas?
 
Upvote 0
Does it occur only with .xls files or only .xlsx files? Is the destination workbook a .xls or a .xlsx/.xlsm file? The 2 versions have different Rows.Count (maximum number of rows) values

Try replacing the PasteSpecial line with:
VBA Code:
With Workbooks("Certification statement automation").Worksheets("Cleared")
    .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row + 1).PasteSpecial
End With
so that .Rows.Count is always correct, regardless of the Excel file type.
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,697
Members
448,293
Latest member
jin kazuya

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top