Hello, I have searched for a solution to this requirement in the many examples which exist but can't find one that does what I need exactly and my vba skills are not good enough to adapt. I would greatly appreciate help from the excel expert community.
I'm trying to combine several BOM files into one worksheet which I can then use with a pivot table. All workbooks are located in one folder. The source workbooks are based upon the existence of several top level part no BOMs - each contains the enquiry date and top level part no in specific cells (A1 & B6) and then the BOM itself starts at row 12 in cells B12:ARx where the number of rows is a variable but the relevant rows always have a number in column B. If there isn't a number in column B from row 12 then the data isn't required. There is only one worksheet containing the BOM for a specific top level part number in each workbook.
The sequence would be;
1. Value of cell A1, B6 and data in range B12:ARx copied.
2. Data pasted into workbook containing the macro (which is located in a different folder to the source data workbooks) such that Cell values of A1 & B6 are repeated on each row pasted. Data from workbook 2 would be pasted under data from workbook 1 etc.
3. Close source workbook and open next workbook, repeat until all workbooks have been processed in the same way.
Please could somebody get me started with this or point me in the right direction?
The code below works slightly differently but may be a useful starting point;
Option Explicit
Const FOLDER_PATH = "C:\Users\sksyk\(LIVE SOURCE)\" 'Must have the Backslash
Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long 'output row
'
Dim wbTarget As Workbook
Set wbTarget = ThisWorkbook
'check the folder exists
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If
Application.ScreenUpdating = False
'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xlsx*")
Do Until sFile = ""
'open the source file and set the source worksheet
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets("Dashboard")
'import the data
wsSource.Range("B2:Z62").Copy
wbTarget.Sheets.Add after:=wbTarget.Sheets(wbTarget.Sheets.Count)
Set wsTarget = wbTarget.ActiveSheet
wbTarget.Activate
wsTarget.Select
ActiveSheet.Pictures.Paste.Select
ActiveSheet.Shapes.Range(Array("Picture 1")).Select
ActiveWindow.DisplayGridlines = False
wsTarget.Name = Replace(sFile, ".xlsx", "")
'close the source workbook, increment the output row and get the next file
wbSource.Close SaveChanges:=False
sFile = Dir()
Loop
Application.ScreenUpdating = True
'tidy up
Set wsSource = Nothing
Set wbSource = Nothing
Set wbTarget = Nothing
Set wsTarget = Nothing
End Sub
'
Private Function FileFolderExists(strPath As String) As Boolean
If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function
Thank you,
Jess
Bookmarks