无法复制单个单元格并粘贴到范围

Question

我对VBA极为陌生，并且我正在学习中，请多多包涵。

我正在尝试将一个文件夹中的多个Excel文件的数据范围复制到一个合并器中。当前，每个文件中都有报告提交者的标识符，我正在尝试将其复制到一个范围中（A3：A-lastrow）。当我达到这一点时就会遇到错误。

更新1-某些人指出了我的第一个错误-包括我的lastrow变量的引号。谢谢！删除了它们，但是现在宏似乎无法在我的源文件和目标文件之间复制粘贴。我如何声明工作簿变量或我调用它们的方式有问题吗？

更新2-经过@Mikku回答并稍作调整后，我可以确定地说代码终于可以工作了！

Sub MainCopy()

Dim SrcBk As Workbook
Dim FSO As Object
Dim Folder As Object
Dim SrcF As Object
Dim F1 As Object
Dim ws As Worksheet
Dim lastrow As Long
Dim DestWk As Worksheet

Set DestWk = ThisWorkbook.Sheets("Output")

'Define source folder
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.Getfolder(ActiveWorkbook.Sheets("Cover").Range("F5"))
Set SrcF = Folder.Files

'Loop files in Directory
For Each F1 In SrcF

    lastrow = DestWk.Cells(DestWk.Rows.Count, "B").End(xlUp).Row

    ThisWorkbook.Sheets("Reference").Select
    ThisWorkbook.Sheets("Reference").Range("A3:C113").Select
    Selection.Copy
    Worksheets("Output").Select
    Range("B" & lastrow + 1).PasteSpecial xlValues


    Set SrcBk = Workbooks.Open(F1)

    Worksheets("Cover").Select
    Range("K1").Copy
    DestWk.Range("A" & DestWk.Cells(DestWk.Rows.Count, "A").End(xlUp).Row & ":" & "A" & lastrow).PasteSpecial Paste:=xlPasteValues

    SrcBk.Worksheet("Data").Range("C7:I38").Copy
    DestWk.Cells("E" & lastrow).PasteSpecial Paste:=xlPasteValues

    lastrow = DestWk.Cells(DestWk.Rows.Count, "I").End(xlUp).Row

    SrcBk.Worksheet("Data").Range("C40:I68").Copy
    DestWk.Cells("E" & lastrow).PasteSpecial Paste:=xlPasteValues

    lastrow = DestWk.Cells(DestWk.Rows.Count, "I").End(xlUp).Row

    SrcBk.Worksheet("Performance").Range("C8:I61").Copy
    DestWk.Cells("E" & lastrow).PasteSpecial Paste:=xlPasteValues

    SrcBk.Close

Next F1


End Sub

Answer 1

替换此行

DestWk.Range("A" & DestWk.Cells(DestWk.Rows.Count, "A").End(xlUp).Row & ":" & "A" & "lastrow").PasteSpecial Paste:=xlPasteValues

使用

DestWk.Range("A" & DestWk.Cells(DestWk.Rows.Count, "A").End(xlUp).Row & ":" & "A" & lastrow).PasteSpecial Paste:=xlPasteValues

您使用的是多余的引号，变量不带引号。

您需要将.Worksheet更改为.Worksheets ....，这在您的代码中几乎出现了4次。

另外，还有一个建议...阅读此答案How to avoid using Select in VBA

---

尝试以下代码：我还做了一些更改。

Sub MainCopy()

Dim SrcBk As Workbook
Dim FSO As Object
Dim Folder As Object
Dim SrcF As Object
Dim F1 As Object
Dim ws As Worksheet
Dim lastrow As Long
Dim DestWk As Worksheet

Set DestWk = ThisWorkbook.Sheets("Output")

'Define source folder
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.Getfolder(ActiveWorkbook.Sheets("Cover").Range("F5"))
Set SrcF = Folder.Files

'Loop files in Directory
For Each F1 In SrcF

    lastrow = DestWk.Cells(DestWk.Rows.Count, "B").End(xlUp).Row

    ThisWorkbook.Sheets("Reference").Range("A3:C113").Copy
    DestWk.Range("B" & lastrow + 1).PasteSpecial Paste:=xlPasteValues


    Set SrcBk = Workbooks.Open(F1)

    SrcBk.Worksheets("Cover").Range("K1").Copy
    DestWk.Range("A" & DestWk.Cells(DestWk.Rows.Count, "A").End(xlUp).Row & ":" & "A" & lastrow).PasteSpecial Paste:=xlPasteValues

    SrcBk.Worksheets("Data").Range("C7:I38").Copy
    DestWk.Range("E" & lastrow).PasteSpecial Paste:=xlPasteValues

    lastrow = DestWk.Cells(DestWk.Rows.Count, "I").End(xlUp).Row

    SrcBk.Worksheets("Data").Range("C40:I68").Copy
    DestWk.Range("E" & lastrow).PasteSpecial Paste:=xlPasteValues

    lastrow = DestWk.Cells(DestWk.Rows.Count, "I").End(xlUp).Row

    SrcBk.Worksheets("Performance").Range("C8:I61").Copy
    DestWk.Range("E" & lastrow).PasteSpecial Paste:=xlPasteValues

    SrcBk.Close

Next F1


End Sub