VBA-复制粘贴到另一个工作簿

时间:2019-05-30 09:42:45

标签: excel vba

我正在尝试将特定单元格从一个工作簿复制到表末尾。 我认为问题在于经常使用“ ActiveWorkbook”。 我收到错误消息“对象不支持此属性或方法”,并且似乎宏从CurrentBook复制了单元格,而不是从上传程序复制了单元格。

如何修复我的代码?


Dim uploadfile As Variant
Dim uploader As Workbook
Dim CurrentBook As Workbook
Dim lastRow As Integer

Set CurrentBook = ActiveWorkbook

uploadfile = Application.GetOpenFilename()
    If uploadfile = "False" Then
        Exit Sub
    End If
Workbooks.Open uploadfile

Set uploader = ActiveWorkbook

With uploader
    Application.CutCopyMode = False
    Range("A1:J100").Copy
End With


CurrentBook.Activate
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & lastRow & ":J" & lastRow + 100).Select
Selection.Paste

uploader.Close

End Sub

3 个答案:

答案 0 :(得分:0)

在这里,仅因为我对工作感到无聊,所以就有成千上万个这样的帖子:

Option Explicit
Sub CopyPaste()

    Dim uploadfile As String 'not Variant, the filename will be a string
    Dim wbCopy As Workbook 'Better than uploader As Workbook you need to declare variables easy to read
    Dim wbPaste As Workbook 'same as above
    Dim LastRow As Lon 'integer doesn't work (it will be a long delimited to integer) either Byte(0-255) or Long

    Set wbPaste = ThisWorkbook 'the workbook containing the code

    uploadfile = Application.GetOpenFilename()
    If uploadfile = "False" Then
        Exit Sub
    End If

    Set wbCopy = Workbooks.Open(uploadfile) 'declare your paste workbook like this

    ' Set uploader = ActiveWorkbook this way of referencing a workbook might give you errors, use the above

    With wbCopy.Sheets("MySheetName") 'reference always the worksheets, change MySheetName for the actual sheet name
        'Application.CutCopyMode = False this is useless here it's emptying the clipboard but below you copy something new
        .Range("A1:J100").Copy 'you missed the . on the beginning (when using With you need to use the dot to reference the with)
    End With

    With wbPaste.Sheets("MySheetName") 'reference always the worksheets, change MySheetName for the actual sheet name
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & LastRow).PasteSpecial xlPasteValues 'when you copy/paste you just need to find the first cell on the paste range, Excel will paste the whole range
    End With

    Application.CutCopyMode = False 'now you can use this to avoid warning message on closing the copy workbook
    wbCopy.Close Savechanges:=False

End Sub

答案 1 :(得分:0)

在VBA中,您不得使用Ative

因此,请替换所有Active,并且您必须使用PasteSpecial,它比Paste更好

Sub test()

Dim uploadfile As Variant
Dim uploader As Workbook
Dim CurrentBook As Workbook
Dim lastRow As Integer

Set CurrentBook = ThisWorkbook

uploadfile = Application.GetOpenFilename()
    If uploadfile = "False" Then
        Exit Sub
    End If
Set uploader = Workbooks.Open(uploadfile)

Application.CutCopyMode = False
uploader.Worksheets(1).Range("A1:J100").Copy

lastRow = CurrentBook.Worksheets(1).Cells(CurrentBook.Worksheets(1).Rows.Count, "A").End(xlUp).Row + 1
Range("A" & lastRow & ":J" & (lastRow + 100)).PasteSpecial xlPasteValues

uploader.Close

End Sub

此代码对我有用

不客气:)

答案 2 :(得分:0)

下面您可以找到有关如何从一个工作簿复制到另一个工作簿的示例代码:

Option Explicit

Sub test()

    Dim wbSource As Workbook, wbDestination As Workbook

    'Set both workbooks by name to avoid conflicts
    Set wbSource = Workbooks("Book1")
    Set wbDestination = Workbooks("Book2")

    'Copy paste only values
    wbSource.Worksheets("Sheet1").Range("A1").Copy
    wbDestination.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues

End Sub