jordanburch
Active Member
- Joined
- Jun 10, 2016
- Messages
- 440
- Office Version
- 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
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