Inefficient Macro - Creating a masterfile

[Tom991]

Hi all,

I have set up a macro to import data from several workbooks into one master workbook. This is my first time creating a macro, and as you can see from below it is not very efficient. I am looking for any tips on how I can improve it, as I need to repeat the process for 25 workbooks. I want to import two specific columns of data (ID number and Date) into two columns in the masterfile. The 25 workbooks are formatted differently (received from external source) and which columns I need to import from will therefore vary from workbook to workbook. The amount of rows that I will need to import will also on a weekly basis.

In the below, I am importing data from "Testfile1" and "Testfile2" into "MasterFile"


Sub Import()
'
' Import Macro
'


'
Application.ScreenUpdating = False

Workbooks.Open ("C:\Users\tom_000\Documents\Excel test file\Testfile1.xlsx")
Range("C2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("MasterFile.xlsx").Activate
Range("D2").Select
ActiveSheet.Paste
Windows("Testfile1.xlsx").Activate
Range("H2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Windows("MasterFile.xlsx").Activate
Range("F2").Select
ActiveSheet.Paste
Windows("Testfile1.xlsx").Activate
ActiveWindow.Close

Workbooks.Open ("C:\Users\tom_000\Documents\Excel test file\Testfile2.xlsx")
Range("B4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("MasterFile.xlsx").Activate
lastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
ActiveSheet.Range("D" & lastRow + 1).Select
ActiveSheet.Paste
Windows("Testfile2.xlsx").Activate
Range("F4").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Windows("MasterFile.xlsx").Activate
lastRow = ActiveSheet.Cells(Rows.Count, "F").End(xlUp).Row
ActiveSheet.Range("F" & lastRow + 1).Select
ActiveSheet.Paste
Windows("Testfile2.xlsx").Activate
ActiveWindow.Close

Application.ScreenUpdating = True

End Sub


I know I need to declare variables etc, but not really sure how to do this. Any help on improving this code would be really appreciated!

Additionally: I would also like the rows in column A in the Masterfile to be populated based on the name of the sourcefile, how can I make a code to do this? Bearing in mind that this needs to correspond with the amount of rows that I have imported from that workbook.

Thank you guys!

 

[ukmikeb]

Cross-posted here - Inefficient Macro - Copying data into a masterfile

 

[dmt32]

Hi,
welcome to the board.

Have you visited Ron de Bruin's site? He has a number of example's that you could probably adapt for your project: Merge data from all workbooks in a folder
You can also download sample workbooks for free.

Hope helpful

Dave

 

[Tom991]

Hi,
welcome to the board.

Have you visited Ron de Bruin's site? He has a number of example's that you could probably adapt for your project: Merge data from all workbooks in a folder
You can also download sample workbooks for free.

Hope helpful

Dave

Thank you Dave,

Had a look at the site, but was not able to adapt the examples he had. My issue is that I only want to import data from two of the columns in the other workbooks, which columns I am importing from will vary from workbook to workbook. Also, in some workbooks I need to import data starting from row 2, whilst in other workbooks I start at a different row.

Is there another way that I can create a code for the copy/paste action?

Thanks!

 

[dmt32]

Thank you Dave,


Is there another way that I can create a code for the copy/paste action?

Thanks!

Possible if the non static columns you want copy from each file have field name headings that are consistent.

Dave

 

[tonyyy]

The following might be a start...

Sub CreateMasterFile()

Dim wb As Workbook
Dim directory As String
Dim fileName As String
Dim wbLastCol As Long
Dim wbLastRow As Long
Dim MasterLastRow As Long
Dim r As Range

Application.ScreenUpdating = False
directory = ThisWorkbook.Path & "\"
fileName = Dir(directory & "*.xlsx")
Workbooks.Open (directory & "MasterFile.xlsx")

Do While fileName <> ""
    Set wb = Workbooks.Open(directory & fileName)
    wbLastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    For Each r In Range(Cells(1, 1), Cells(1, wbLastCol))
        If r = "ID Number" Then
            wbLastRow = Cells(Rows.Count, r.Column).End(xlUp).Row
            Range(Cells(r.Row + 1, r.Column), Cells(wbLastRow, r.Column)).Copy
            Workbooks("MasterFile.xlsx").Activate
            MasterLastRow = Cells(Rows.Count, "D").End(xlUp).Row + 1
            Range("D" & MasterLastRow).Activate
            ActiveSheet.Paste
        Else
            If r = "Date" Then
                wbLastRow = Cells(Rows.Count, r.Column).End(xlUp).Row
                Range(Cells(r.Row + 1, r.Column), Cells(wbLastRow, r.Column)).Copy
                Workbooks("MasterFile.xlsx").Activate
                MasterLastRow = Cells(Rows.Count, "F").End(xlUp).Row + 1
                Range("F" & MasterLastRow).Activate
                ActiveSheet.Paste
            End If
        End If
        wb.Activate
    Next r
    If wb.Name <> "MasterFile.xlsx" Then wb.Close savechanges:=False
    fileName = Dir
Loop

Application.ScreenUpdating = True
MsgBox "The dishes are done, dude!"

End Sub

The code assumes you have consistent headings (as mentioned by Dave), and that the headings are in Row 1. The code should be placed in a new workbook, and that workbook should be saved to the same folder as the MasterFile.xlsx and source files.

Cheers,

tonyyy