使用Excel VBA將多個電子表格有效地導入到一個主表中

Question

我是VBA的新手，我編寫了一些代碼，盡管它可以正常工作，但我認為它很笨重，如果需要進行更改，效果不是很好。

該代碼打開一個電子表格，運行一個函數（稱為“ LastRow”）以復制數據，並運行另一個函數（稱為“ NxtRow”）以將其粘貼到帶有宏的電子表格的下一個空行中，然后關閉復制數據的工作表從並移至下一個。 基本上，它是將多張紙串聯在一起。

我認為必須有一種方法來編寫代碼，以一次調用函數，然后循環遍歷列表中的每個工作表。 這可能嗎？

我的代碼是：

NxtRow（）函數

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（）函數

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

以此方式進行約30張紙。 有沒有更簡單的方法可以編寫此代碼，並在需要時使其更易於以后修改？

Answer 1

我只是對您的文件名進行一些排列，然后使用for循環根據需要重復執行多次函數調用

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