VBA Macro to copy specific cells in different workbooks to a single master workbook

[MarkR3003]

Hi

Dont know where to start with this request....

I have many excel files all of exactly the same structure with different data but each one is saved / named differently - lets call these files 'Form 1.xls', 'Form 2.xls' and 'Form 3.xls' - see attached

I want to be able to open each file called 'Form 1 etc' in turn and use a personal macro to copy specific cells in this file and their values into a master workbook into a common table to bring all the information together - lets call this file 'Master.xls' - see attached

Form 1

Form 2

Form 3

Master

Appreciate any advice or VBA code that I could start with


Thanks

 

[John_w]

See if you can adapt this code for a similar request:

Macro to Extract Specific cell data from Multiple Worksbooks into one summary.

Hi, I have a bunch of excel files (3000) that I need to extract data from specific Cells in these spreadsheet and paste them to a summary sheet. Q10:V10 -> B8:G8; Q13:V13 -> H8:M8; Q16:V16 -> N8-S8; B14 -> A8 Next Spreadsheet would be Q10:V10 -> B9:G9; Q13:V13 -> H9:M9; Q16:V16 -> N9:S9; B14...

www.mrexcel.com

 

[MarkR3003]

Thanks John/w

The solution works well and has solved my problem
Just one question though...the macro deletes the column headers from the destination sheet (destSheet) when the matching workbook data has been pasted in. Is there any amendment to the VBA that I can use to retain the column headers in the destSheet?
Thanks

Welcome to MrExcel forums.

Try this macro, changing the workbooks folder and filespec and destination sheet name where indicated.

Public Sub Copy_Values_From_Workbooks()

    Dim matchWorkbooks As String
    Dim destSheet As Worksheet, r As Long
    Dim folderPath As String
    Dim wbFileName As String
    Dim fromWorkbook As Workbook
  
    'Folder path and wildcard workbook files to import cells from
  
    matchWorkbooks = "C:\folder\path\*.xls"                                             'CHANGE THIS
  
    'Define destination sheet
  
    Set destSheet = ActiveWorkbook.Worksheets("Summary")                                'CHANGE THIS
  
    destSheet.Cells.Clear
    r = 0
  
    Application.ScreenUpdating = False
          
    folderPath = Left(matchWorkbooks, InStrRev(matchWorkbooks, "\"))
    wbFileName = Dir(matchWorkbooks)
    While wbFileName <> vbNullString
        Set fromWorkbook = Workbooks.Open(folderPath & wbFileName)
        With fromWorkbook.Worksheets(1)
            destSheet.Range("B8:G8").Offset(r).Value = .Range("Q10:V10").Value
            destSheet.Range("H8:M8").Offset(r).Value = .Range("Q13:V13").Value
            destSheet.Range("N8:S8").Offset(r).Value = .Range("Q16:V16").Value
            destSheet.Range("A8").Offset(r).Value = .Range("B14").Value
            r = r + 1
        End With
        fromWorkbook.Close savechanges:=False
        DoEvents
        wbFileName = Dir
    Wend
  
    Application.ScreenUpdating = True
  
    MsgBox "Finished"
  
End Sub

 

[John_w]

the macro deletes the column headers from the destination sheet (destSheet) when the matching workbook data has been pasted in.

I can't see any code which deletes the column headers.

Post your adaptation of the macro.

 

[MarkR3003]

Thanks for the reply

I have only tested it with two cells to copy into a Masterdata table using the macro below


Public Sub Copy_Values_From_Workbooks()

Dim matchWorkbooks As String
Dim destSheet As Worksheet, r As Long
Dim folderPath As String
Dim wbFileName As String
Dim fromWorkbook As Workbook

'Folder path and wildcard workbook files to import cells from

matchWorkbooks = "C:\Users\M5070839\Documents\1. SG Insulation UK\07. Commercial Support Calculator\Dev File\Source Files\*.xls" 'CHANGE THIS

'Define destination sheet

Set destSheet = ActiveWorkbook.Worksheets("MasterData") 'CHANGE THIS

destSheet.Cells.Clear
r = 0

Application.ScreenUpdating = False

folderPath = Left(matchWorkbooks, InStrRev(matchWorkbooks, "\"))
wbFileName = Dir(matchWorkbooks)
While wbFileName <> vbNullString
Set fromWorkbook = Workbooks.Open(folderPath & wbFileName)
With fromWorkbook.Worksheets(1)
destSheet.Range("A4").Offset(r).Value = .Range("C13").Value
destSheet.Range("B4").Offset(r).Value = .Range("C3").Value
r = r + 1
End With
fromWorkbook.Close savechanges:=False
DoEvents
wbFileName = Dir
Wend

Application.ScreenUpdating = True

MsgBox "Finished"

End Sub

 

[John_w]

Delete destSheet.Cells.Clear

 

[MarkR3003]

Many thanks. Great support and knowledge.

 

[MarkR3003]

Just one final question...

If I need the code to take the copy cells from a specific tab in each of the matchWorkbook files, how would I amend this line of code to add the worksheet tab name which is the same in each of the matchWorkbook files

matchWorkbooks = "C:\Users\M5070839\Documents\1. SG Insulation UK\07. Commercial Support Calculator\Dev File\Source Files\*.xls" - how to add the worksheet tab name?

 

[MarkR3003]

Hi John_w
Would you be able to advice how I can copy data from a specific worksheet tab in the matchWorkbook coding as each workbook has multiple tabs and I think that the macro is looking at the first worksheet in each workbook rather than the worksheet that I need it to
Many thanks for your help again

 

[John_w]

Change:

With fromWorkbook.Worksheets(1)

to:

With fromWorkbook.Worksheets("name of sheet")