VBA代码不会将数据粘贴到最后一行

时间:2019-07-17 19:16:31

标签: excel vba

我编写了一些代码,以对两个工作簿中的数据进行格式化,然后将它们粘贴到主工作簿中。我移到主工作簿的第一个数据集工作正常,但第二个数据集未粘贴到下一个打开的行。

当我运行分别提取数据的代码时,它可以工作,但是当我将第2个宏调用到第一个宏时,它不起作用,这就是我想要的样子。

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数据不会弹出,除非我分别运行这两个函数。

0 个答案:

没有答案