I have a program that generates an excel file under the name "cutlist.xlsx" consistently, that I require 2 sheets from named "SheetComponentListing" and "SheetStockSummary". I am generating these "cutlist.xlsx" files on a per job basis, and each job has its own folder with a file called "cutlist.xlsx"

Basically, I have created a spreadsheet that is intended to be printed for our shop floor, to display what is in this cutlist.xlsx file in a way that is readable, and also add additional information.

Currently, I have all my formulas linked to sheet names "PH1" and "PH2" which are just being used as placeholders to avoid a #REF error when the sheet doesn't exist. I am manually copying the "SheetComponentListing" and "SheetStockSummary" from the "cutlist.xlsx" workbook to the new one, and then doing a find and replace so PH1 = "SheetComponentListing" and PH2 = "SheetStockSummary".

All this works well, however I am needing to pass this off to other people in my workplace who will not be able to complete that task manually.

How would I go about creating a macro that would do this:

1. Search the directory of the current opened workbook and open "cutlist.xlsx"
2. Copy "SheetComponentListing" and "SheetStockSummary" from the "cutlist.xlsx" workbook and paste in the original workbook
3. Find and replace so PH1 = "SheetComponentListing" and PH2 = "SheetStockSummary"

If anyone is able to give me some tips with this I would greatly appreciate it.

CodePudding user response：

Import Worksheets

• Adjust the values in the constants section (the destination worksheet name, dName, was never mentioned).

Option Explicit

Sub Retrieve_Cutlist()
    
    Const sFileName As String = "cutlist.xlsx"
    Const wsNameList As String = "SheetComponentListing,SheetStockSummary"
    Const dName As String = "Sheet1"
    Const dPlaceHolderList As String = "PH1,PH2"
    
    Dim FolderPath As String: FolderPath = ThisWorkbook.path & "\"
    Dim sFilePath As String: sFilePath = FolderPath & sFileName
    Dim swb As Workbook: Set swb = Workbooks.Open(sFilePath)
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim wsNames() As String: wsNames = Split(wsNameList, ",")
    
    Application.ScreenUpdating = False
    
    swb.Worksheets(wsNames).Copy After:=dwb.Sheets(dwb.Sheets.Count)
    
    Dim dPlaceHolders() As String: dPlaceHolders = Split(dPlaceHolderList, ",")
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dName)
    
    Dim n As Long
    
    For n = 0 To UBound(dPlaceHolders)
        dws.UsedRange.Replace dPlaceHolders(n), wsNames(n), xlPart, , False
    Next n
    
    swb.Close SaveChanges:=False
    'dwb.Save
    
    Application.ScreenUpdating = True
    
    MsgBox "Worksheets imported.", vbInformation

End Sub

CodePudding user response：

NOT TESTED. Here ya go.

Sub Retrieve_Cutlist()

    Dim path As String: path = ThisWorkbook.path
    Dim file_name As Variant: file_name = Dir(path & "\cutlist.xlsx")
    
    If file_name = "" Then
        MsgBox path & "\cutlist.xlsx" & vbNewLine & "Is not found, data is not updated"
        Exit Sub
    End If
    
    Dim ph1_flag As Boolean: ph1_flag = False
    Dim ph2_flag As Boolean: ph2_flag = False
    
    Dim wb As Workbook: Set wb = Workbooks.Open(path & "\cutlist.xlsx", ReadOnly:=True)
    Dim sht1 As Worksheet
    For Each sht1 In wb.Sheets
        If sht1.Name = "SheetComponentListing" Then
            ThisWorkbook.Sheets("PH1").Delete
            sht1.Copy Before:=ThisWorkbook.Sheets(1)
            ThisWorkbook.Sheets(1).Name = "PH1"
            ph1_flag = True
        ElseIf sht1.Name = "SheetStockSummary" Then
            ThisWorkbook.Sheets("PH2").Delete
            sht1.Copy Before:=ThisWorkbook.Sheets(1)
            ThisWorkbook.Sheets(1).Name = "PH2"
            ph2_flag = True
        End If
    Next
    
    wb.Close SaveChanges:=False
    
    MsgBox "PH1 Updated?", ph1_flag _
    & vbNewLine & "PH2 Updated?", ph2_flag

End Sub