Import workbook using a predetermined directory and the name found in a cell

Question

I currently import sheets of data into excel that I am exporting from CAD. This includes summaries, counts and other data. I would like to add to the code so that it will import a file from a predetermined directory C:\Jobs\packlist and using a number inside a cell ='PL CALC'!B1 (this will determine the file name). The idea being to remove the open dialog box and increase automation.

This is what I have found that works so far. It opens a selected file and copies it into the workbook after sheet 18.

'import excel data sheet

Sub import()

Dim fName As String, wb As Workbook

'where to look for the framecad excel file

ChDrive "C:"
ChDir "C:\Jobs\packlist"

fName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*")
Set wb = Workbooks.Open(fName)
    For Each sh In wb.Sheets
            Sheets.Copy After:=ThisWorkbook.Sheets(18)
            Exit For
            Next
    wb.Close False      
    Worksheets("PL CALC").Activate

End Sub

What's your question? You didn't ask one (see [ask]). Also incude what problems you faced, and what did not work. Or did you just mean to replace the open dialog with `fName = ThisWorkbook.Worksheets("PL CAC").Range("B1").Value`? — Pᴇʜ, Nov 23 '21 at 11:00
Is there only one sheet in the workbook where from your code tries copying? If not, `Exit For` will allow only the first sheet copying. Then, you can replace all above the loop with: `fName = "C:\Jobs\packlist\" & ThisWorkbook.Worksheets("PL CAC").Range("B1").Value`. — FaneDuru, Nov 23 '21 at 11:25
@Pᴇʜ yup sorry, the question is how can I amend my code to do what is required. — pwent, Nov 23 '21 at 19:33
@FaneDuru there are potentially unlimited sheets in the cad exported workbook. — pwent, Nov 23 '21 at 19:37

score 0 · Accepted Answer · answered Nov 23 '21 at 12:17

Import Sheets

Option Explicit

Sub ImportSheets()
    Const ProcTitle As String = "Import Sheets"

    Const sFolderPath As String = "C:\Jobs\packlist\"
    Const sfnAddress As String = "B1"
    Const sFileExtensionPattern As String = ".xls*"
    
    Const dwsName As String = "PL CALC"
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dwsName)
    
    Dim sFilePattern As String: sFilePattern = sFolderPath & "*" _
        & dws.Range(sfnAddress).Value & sFileExtensionPattern
    
    Dim sFileName As String: sFileName = Dir(sFilePattern)
    If Len(sFileName) = 0 Then
        MsgBox "No file found..." & vbLf & "'" & sFilePattern & "'", _
            vbCritical, ProcTitle
        Exit Sub
    End If

    Application.ScreenUpdating = False
    
    Dim swb As Workbook: Set swb = Workbooks.Open(sFolderPath & sFileName)
        
    Dim sh As Object
        
    For Each sh In swb.Sheets
        sh.Copy After:=dwb.Sheets(dwb.Sheets.Count)
    Next sh
    
    swb.Close SaveChanges:=False
    
    dws.Activate
    'dwb.Save
    
    Application.ScreenUpdating = True
    
    MsgBox "Sheets imported.", vbInformation, ProcTitle
    
End Sub

Import workbook using a predetermined directory and the name found in a cell

1 Answers1

Import Sheets