Import with partial sheet name

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
402
Office Version
  1. 2016
Hey guys

I have the below code. it loops through and imports the active sheet, but I want it to import the sheet with the partial name of "Clear". It only import the active sheet when it opens the file. Can anyone help?

Sub LoopThroughFiles()
Dim MyObj As Object
Dim MySource As Object
Dim file As Variant
Dim wbThis As Workbook 'workbook where the data is to be pasted, aka Master file
Dim wbTarget As Workbook 'workbook from where the data is to be copied from, aka Overnights file
Dim LastRow As Long
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Application.DisplayAlerts = False
'set to the current active workbook (the source book, the Master!)
Set wbThis = ActiveWorkbook

Set sht1 = wbThis.Sheets("Cleared")

Folder = "C:\Users\jordan.burch.ctr\Desktop\Cert Statements\"
Fname = Dir(Folder)

While (Fname <> "")

Set wbTarget = Workbooks.Open(Filename:=Folder & Fname)
wbTarget.Activate
Dim ws As Worksheet
Dim ClearedSheet As String
ClearedSheet = ""
For Each ws In ActiveWorkbook.Worksheets
If InStr(1, ws.Name, "Clear", vbTextCompare) Then
ClearedSheet = ws.Name

With ActiveSheet
If .AutoFilterMode Then
If .FilterMode Then
.ShowAllData
End If
Else
If .FilterMode Then
.ShowAllData
End If
End If
End With

Range("a2:aw40000").Copy
Exit For
End If
Next
If ClearedSheet <> "" Then
' Sheets("Cleared - Cleared to").Activate


' With ActiveSheet
' If .AutoFilterMode Then
' If .FilterMode Then
' .ShowAllData
' End If
' Else
' If .FilterMode Then
' .ShowAllData
' End If
' End If
' End With

Range("a2:aw40000").Copy

wbThis.Activate

'Just add this line:
LastRow = sht1.Range("b1").End(xlDown).Row + 1
'And alter this one as follows:
sht1.Range("a" & Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial

Fname = Dir

'close the overnight's file
wbTarget.Close
End If
Wend

Application.DisplayAlerts = True
End Sub



Thanks,

Jordan
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

Dan_W

Well-known Member
Joined
Jul 11, 2018
Messages
992
Office Version
  1. 365
Platform
  1. Windows
Hi. I've played around with the code and hopefully the following works.
When you try it, make sure you use it on dummy data, or backed-up data. I've made certain assumptions about what you were hoping to achieve, because it wasn't immediately clear from the code. One point I should make is that now I've told the code to close the source workbook (wbTarget) without saving it. Is that what you were trying to bypass with the DisplayAlerts setting? If so, you can probably delete those two lines of code - you can accomplish the same goal by adding a FALSE after the .Close method.

I suspect that part of the problem was the use of ActiveWorkbook and ActiveSheet - when Excel is being asked to flip between different workbooks and sheets, you may inadvertently be telling it to get data from / paste data to the wrong worksheet. Let me know if this works:

VBA Code:
Sub LoopThroughFiles()

    Dim wbTarget    As Workbook      
    Dim sht1        As Worksheet
    Dim ws      As Worksheet
    
    Application.DisplayAlerts = False

    Set sht1 = ThisWorkbook.Sheets("Cleared")
    
    Folder = "C:\Users\jordan.burch.ctr\Desktop\Cert Statements\"
    fname = Dir(Folder)
        
    While (fname <> "")
        Set wbTarget = Workbooks.Open(Filename:=Folder & fname)
        For Each ws In wbTarget.Worksheets
            If InStr(1, ws.Name, "Clear", vbTextCompare) Then
                If ws.FilterMode Then ws.ShowAllData
                Range(ws.Cells(2, 2), ws.Cells(40000, 49)).Copy
                sht1.Range("a" & Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
            End If
        Next
        fname = Dir
        wbTarget.Close False
    Wend

    Application.DisplayAlerts = True

End Sub
 

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
402
Office Version
  1. 2016
Hi. I've played around with the code and hopefully the following works.
When you try it, make sure you use it on dummy data, or backed-up data. I've made certain assumptions about what you were hoping to achieve, because it wasn't immediately clear from the code. One point I should make is that now I've told the code to close the source workbook (wbTarget) without saving it. Is that what you were trying to bypass with the DisplayAlerts setting? If so, you can probably delete those two lines of code - you can accomplish the same goal by adding a FALSE after the .Close method.

I suspect that part of the problem was the use of ActiveWorkbook and ActiveSheet - when Excel is being asked to flip between different workbooks and sheets, you may inadvertently be telling it to get data from / paste data to the wrong worksheet. Let me know if this works:

VBA Code:
Sub LoopThroughFiles()

    Dim wbTarget    As Workbook     
    Dim sht1        As Worksheet
    Dim ws      As Worksheet
   
    Application.DisplayAlerts = False

    Set sht1 = ThisWorkbook.Sheets("Cleared")
   
    Folder = "C:\Users\jordan.burch.ctr\Desktop\Cert Statements\"
    fname = Dir(Folder)
       
    While (fname <> "")
        Set wbTarget = Workbooks.Open(Filename:=Folder & fname)
        For Each ws In wbTarget.Worksheets
            If InStr(1, ws.Name, "Clear", vbTextCompare) Then
                If ws.FilterMode Then ws.ShowAllData
                Range(ws.Cells(2, 2), ws.Cells(40000, 49)).Copy
                sht1.Range("a" & Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
            End If
        Next
        fname = Dir
        wbTarget.Close False
    Wend

    Application.DisplayAlerts = True

End Sub
thanks Dan! works like a charm. I appreciate your help!

Jordan
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,396
Messages
5,837,019
Members
430,467
Latest member
FrazzledbyExcel

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
Top