In need of Tweak to old Code

bradjedis
4StarLounger
Posts: 536
Joined: 30 Mar 2010, 18:49
Location: United States

In need of Tweak to old Code

Post by bradjedis »

Greetings, I have the below code that works well enough, however I would like to limit it to import only one specific Sheet from each of the files it is querying. The files this imports has multiple sheets in each workbook. I would like to limit to a sheet Named "PBR". each workbook will have a sheet named that.

Code: Select all

Sub InportSheets()

Dim directory As String, fileName As String, sheet As Worksheet, total As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = "C:\Users\xxx\Downloads\__PBRs for Test Load\"
fileName = Dir(directory & "*.xl??")

Do While fileName <> ""
    Workbooks.Open (directory & fileName)
        
    For Each sheet In Workbooks(fileName).Worksheets
        total = Workbooks("import-sheets.xlsm").Worksheets.Count
        Workbooks(fileName).Worksheets(sheet.Name).Copy _
        after:=Workbooks("import-sheets.xlsm").Worksheets(total)
    Next sheet
        
    Workbooks(fileName).Close
    fileName = Dir()
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

User avatar
HansV
Administrator
Posts: 78237
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: In need of Tweak to old Code

Post by HansV »

Here you go:

Code: Select all

Sub ImportPBR()
    Dim directory As String
    Dim fileName As String
    Dim wbkS As Workbook
    Dim wbkT As Workbook
    Dim sheet As Worksheet
    Dim total As Integer

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wbkT = Workbooks("import-sheets.xlsm")

    directory = "C:\Users\xxx\Downloads\__PBRs for Test Load\"
    fileName = Dir(directory & "*.xl??")

    Do While fileName <> ""
        Set wbkS = Workbooks.Open(directory & fileName)
        Set sheet = wbkS.Worksheets("PBR")
        total = wbkT.Worksheets.Count
        sheet.Copy After:=wbkT.Worksheets(total)
        wbkS.Close SaveChanges:=False
        fileName = Dir
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Best wishes,
Hans

bradjedis
4StarLounger
Posts: 536
Joined: 30 Mar 2010, 18:49
Location: United States

Re: In need of Tweak to old Code

Post by bradjedis »

Sorry for delay in replying... This works great!

Many thanks!

bradjedis
4StarLounger
Posts: 536
Joined: 30 Mar 2010, 18:49
Location: United States

Re: In need of Tweak to old Code

Post by bradjedis »

Hans. I am wondering if there can be an "OR" set up to look at "Set sheet = wbkS.Worksheets("PBR")" line to allow for Sheet1 as a target sheet?

User avatar
HansV
Administrator
Posts: 78237
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: In need of Tweak to old Code

Post by HansV »

What do you mean by

an "OR" set up
Best wishes,
Hans

bradjedis
4StarLounger
Posts: 536
Joined: 30 Mar 2010, 18:49
Location: United States

Re: In need of Tweak to old Code

Post by bradjedis »

Some of the workbooks will have "PBR" as the target sheet name, and others will be "Sheet1" I am wondering if there is a way to handle that in the code for selecting the target sheet to grab the data from.

User avatar
HansV
Administrator
Posts: 78237
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: In need of Tweak to old Code

Post by HansV »

Try this:

Code: Select all

Sub ImportPBR()
    Dim directory As String
    Dim fileName As String
    Dim wbkS As Workbook
    Dim wbkT As Workbook
    Dim sheet As Worksheet
    Dim total As Integer

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wbkT = Workbooks("import-sheets.xlsm")

    directory = "C:\Users\xxx\Downloads\__PBRs for Test Load\"
    fileName = Dir(directory & "*.xl??")

    Do While fileName <> ""
        Set wbkS = Workbooks.Open(directory & fileName)
        Set sheet = Nothing
        On Error Resume Next
        Set sheet = wbkS.Worksheets("PBR")
        If sheet Is Nothing Then
            Set sheet = wbkS.Worksheets("Sheet1")
            If sheet Is Nothing Then
                MsgBox "PBR nor Sheet1 found!", vbExclamation
            End If
        End If
        total = wbkT.Worksheets.Count
        sheet.Copy After:=wbkT.Worksheets(total)
        On Error GoTo 0
        wbkS.Close SaveChanges:=False
        fileName = Dir
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Best wishes,
Hans

bradjedis
4StarLounger
Posts: 536
Joined: 30 Mar 2010, 18:49
Location: United States

Re: In need of Tweak to old Code

Post by bradjedis »

Works great. I am curious as to what Order the files are opened in? Any Idea?

User avatar
HansV
Administrator
Posts: 78237
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: In need of Tweak to old Code

Post by HansV »

Dir sorts files in ascending order by name.
Best wishes,
Hans