简体   繁体   中英

Efficiently import multiple spreadsheets into one master sheet using Excel VBA

I am new to VBA and I have some code which I have written and although it works I think it is bulky and not very good should a change ever need to be made to it.

The code opens a spreadsheet, runs a Function (Called "LastRow") to copy the data and another (Called "NxtRow")to paste it into the next empty row of the spreadsheet with the macro then closes the sheet that the data was copied from and moves on to the next one. Basically it is concatenating multiple sheets into one.

I am thinking that there must be a way to write the code to call the functions once and then loop through each sheet in a list. Is this possible?

My code is:

NxtRow() Function

Public Function NxtRow()
Dim BlankRow As Long
Windows("GA_BudgetTool_MASTER.xlsm").Activate
BlankRow = Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(BlankRow, 1).Select
ActiveSheet.Paste
BlankRow = Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(BlankRow, 1).Select
End Function

LstRow() Function

Public Function LastRow()
Dim LstRow As Long, LstCol As Long, Rng As Range, A3 As Range
LstRow = Range("A" & Rows.Count).End(xlUp).Row
LstCol = Range("O" & LstRow).Column
Set Rng = Range(Cells(LstRow, 1), Cells(LstRow, LstCol))
Set A3 = Range("A3")
Range(A3, Rng).Select
Selection.Copy
End Function

VBA Sub()

Sub ImpData()

'   Deactivate Screen Updating and Display Alerts
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'   Import Worksheet 1
Workbooks.Open Filename:= _
"Worksheet1_Filename.xlsx"
LastRow
NxtRow
Windows("Worksheet1.xlsx").Activate
ActiveWindow.Close

'   Import Worksheet 2
Workbooks.Open Filename:= _
"Worksheet2_Filename.xlsx"
LastRow
NxtRow
Windows("Worksheet2.xlsx").Activate
ActiveWindow.Close

'   Import Worksheet 3
Workbooks.Open Filename:= _
"Worksheet3_Filename.xlsx"
LastRow
NxtRow
Windows("Worksheet3.xlsx").Activate
ActiveWindow.Close

This goes on in this fashion for about 30 sheets. Is there an easier way to write this and make it easier to amend later if needed?

I would just make a little array of your filenames and then use a for loop to repeat the function calls as many times as necessary

Sub ImpData()

    'Deactivate Screen Updating and Display Alerts
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    Dim filenames As Variant
    filenames = Array("file1", "file2")

    For i = 1 To UBound(filenames) + 1
        Workbooks.Open Filename:=filenames(i - 1)
        LastRow
        NxtRow
        Windows("Worksheet" & i & ".xlsx").Activate
        ActiveWindow.Close
    Next i

    'Reactivate Screen Updating and Display Alerts
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM