尝试将数据从一个工作表发送到另一个工作表时出现问题

时间:2015-12-17 08:48:08

标签: excel vba excel-vba

我尝试将数据从一个工作表发送到非活动工作簿中的另一个工作表。代码正确地复制数据并按我的意愿关闭我的工作簿,但它不会粘贴数据。我每个月都要发送数据,我希望在旧版本之后添加新数据。

有人能帮我找到错误吗?

Sub Send()


Workbooks.Open Filename:="FILENAME"

Workbooks("NAME").Activate
Worksheets("Sheet1").Activate

Range("A3:D19").Copy


ActiveWorkbook.Close True

Workbooks("NAME").Activate



erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))
ActiveWorkbook.Save
ActiveWorkbook.Close True

End Sub

2 个答案:

答案 0 :(得分:0)

您无需激活工作簿或工作表即可复制/粘贴数据。 实际上,最好不要这样做,因为它非常耗时,并且当工作表之间的宏跳转时屏幕会闪烁。

以下是代码应该如何完成(代码中的注释)。您只需将路径放到源文件和目标文件中即可。

Sub Send()
    'Prefixes means:
    '   wkb - workbook
    '   wks - worksheet
    '   rng - range
    Dim wkbSource As Excel.Workbook
    Dim wkbDestination As Excel.Workbook
    Dim wksSource As Excel.Worksheet
    Dim wksDestination As Excel.Worksheet
    Dim rngSource As Excel.Range
    Dim rngDestination As Excel.Range
    Dim lastRow As Long
    Dim sourceFilePath As String
    Dim destinationFilePath As String
    '----------------------------------------


    'Defining paths to files.
    sourceFilePath = "..."
    destinationFilePath = "..."

    'Set references to source workbook, worksheet, range.
    Set wkbSource = Workbooks.Open(Filename:=sourceFilePath)
    Set wksSource = wkbSource.Worksheets("Sheet1")
    Set rngSource = wksSource.Range("A3:D19")

    'Set references to destination workbook, worksheet, range.
    Set wkbDestination = Workbooks.Open(Filename:=destinationFilePath)
    Set wksDestination = wkbDestination.Worksheets("Sheet1")
    With wksDestination
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        Set rngDestination = .Range(.Cells(lastRow, 1), .Cells(lastRow, 4))
    End With


    Call rngSource.Copy(Destination:=rngDestination)


    'Close files and clear variables.
    Call wkbSource.Close(False)
    Call wkbDestination.Close(True)

End Sub

答案 1 :(得分:0)

这有效:

Sub Send()
Dim wb As Workbook
Set wb = Workbooks.Open("C:\...\Name.xlsx")
wb.Worksheets(1).Range("A3:D19").Copy
ThisWorkbook.Worksheets(1).Range("A1").PasteSpecial xlPasteValues
wb.Close
End Sub

这样做wb必须打开,直到copy paste完成。如果要在object中保存所有数据之前关闭它。如果我错了,请纠正我。