excel - VBA 代码不会在最后一行粘贴数据

Question

我编写了一些代码来在我的数据格式化后从两个工作簿中获取数据，然后将它们粘贴到主工作簿中。我移动到主工作簿的第一个数据集工作正常，但第二个数据集没有粘贴到下一个打开的行。

当我运行单独提取数据的代码时，它可以工作，但是当我将第二个宏调用到第一个宏时，它不起作用，这就是我想要的。

Sub file1()
'
' test Macro
'

'
'file 1 grabs the latest data
  Application.ScreenUpdating = False
    Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim LMD As Date

    MyPath = "C:\Users\TAmon1\Desktop\AAV Utilization Report\E"
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    MyFile = Dir(MyPath & "*.xlsx", vbNormal)
    If Len(MyFile) = 0 Then
        MsgBox "No files were found...", vbExclamation
        Exit Sub
    End If
    Do While Len(MyFile) > 0
        LMD = FileDateTime(MyPath & MyFile)
        If LMD > LatestDate Then
            LatestFile = MyFile
            LatestDate = LMD
        End If
        MyFile = Dir
    Loop
Workbooks.Open MyPath & LatestFile
'Variables for Vlookup
Dim wbcsv As Workbook, wbplanning As Workbook
Set wbplanning = Workbooks("Planning_tool.xlsm")
Set wbcsv = Workbooks.Open(MyPath & LatestFile)
Dim wb As Workbook
Set lol = Workbooks.Open(MyPath & LatestFile)



'formats data to what I want    ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort.SortFields.Add2 _
        Key:=Range("Table1[[#All],[SLIPED_CIR]]"), SortOn:=xlSortOnValues, Order _
        :=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
' Copy data from file one
   Range("a4").CurrentRegion.Select
    Selection.Copy
    Windows("Compile1").Activate
    Range("a1").Select
    ActiveSheet.Paste
lol.Close savechanges:=False
End Sub
 '^^^^Code above works... calling file two doesn't work :(

call file2
Sub file2()
'grabs latest data
    Dim MyPath2 As String
    Dim MyFile2 As String
    Dim LatestFile2 As String
    Dim LatestDate2 As Date
    Dim LMD2 As Date   
    MyPath2 = "C:\Users\TAmon1\Desktop\AAV Utilization Report\nsn"
    If Right(MyPath2, 1) <> "\" Then MyPath2 = MyPath2 & "\"
    MyFile2 = Dir(MyPath2 & "*.xlsx", vbNormal)
    If Len(MyFile2) = 0 Then
        MsgBox "No files were found...", vbExclamation
        Exit Sub
    End If
    Do While Len(MyFile2) > 0
        LMD2 = FileDateTime(MyPath2 & MyFile2)
        If LMD2 > LatestDate2 Then
            LatestFile2 = MyFile2
            LatestDate2 = LMD2
        End If
        MyFile2 = Dir
    Loop
Workbooks.Open MyPath2 & LatestFile2
'Variables for Vlookup
Dim wbcsv2 As Workbook, wbplanning2 As Workbook
Set wbplanning2 = Workbooks("Planning_tool.xlsm")
Set wbcsv2 = Workbooks.Open(MyPath2 & LatestFile2)
Dim wb2 As Workbook
Set lol2 = Workbooks.Open(MyPath2 & LatestFile2)
'formats file2
   ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort.SortFields.Add2 _
        Key:=Range("Table1[[#All],[SLIPED_CIR]]"), SortOn:=xlSortOnValues, Order _
        :=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   Range("a4").Select
   Selection.CurrentRegion.Select
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Copy
    Windows("Compile1").Activate
' paste file two...    
'uses offset and xlup function to fin the next open row and insert data
ActiveWorkbook.Worksheets("Sheet1").Range("A65000").End(xlUp).Offset(1).PasteSpecial xlPasteAll






lol2.Close savechanges:=False

End Sub

文件 2 数据应该在文件 1 数据下，但文件 2 数据不会弹出，除非我分别运行这两个函数。

标签： excelvba