Excel VBA 粘贴错误"...isn't the same size..."

Question

nb：我是vba的新手，一般代码

我试图制作一个宏，以从多个工作簿中汇总数据并将其导入到主工作簿（'zmaster'）中。

以下代码在多个工作簿中（来自文件C： Automelinh）中成功复制了单元格C5的数据，并将它们粘贴到我的" Zmaster"工作簿中的列中。

问题是我遇到错误'粘贴的数据与选择的大小不同。你想还是要粘贴？'。这是在每次糊状物之后都出现的，因此我每次都必须单击"确定"。合并的复制细胞的格式（在C5和D5之间）。我认为这是问题，但是我不知道如何在VBA代码中减轻这种情况：

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = "C:AutoMelinh"
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
    If MyFile = "ZMaster.xlsm" Then
    Exit Sub
    End If
    Workbooks.Open (Filepath & MyFile)
    Range("C5").Copy
    ActiveWorkbook.Close
    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))
    MyFile = Dir
Loop
End Sub

编辑：我能够使用

解决问题

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = "C:AutoMelinh"
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
    If MyFile = "ZMaster.xlsm" Then
    Exit Sub
    End If
    Application.DisplayAlerts = False
    Workbooks.Open (Filepath & MyFile)
    Range("C5").Copy
    ActiveWorkbook.Close
    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))
    MyFile = Dir
    Application.DisplayAlerts = True
Loop
End Sub

Answer 1

您正在获取警告，因为您将一个单元粘贴到4个单元格中

这应该在不使用复制/粘贴

的情况下工作

Sub LoopThroughDirectory()
    Dim Filepath As String
    Filepath = "C:AutoMelinh"
    Dim MyFile As String
    MyFile = Dir(Filepath)
    Dim erow As Range
    Dim wb As Workbook
    Do While Len(MyFile) > 0
        If MyFile = "ZMaster.xlsm" Then Exit Sub
        Set wb = Workbooks.Open(Filepath & MyFile)
        erow = Workbooks("ZMaster.xlsm").Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        erow.Value = wb.Sheets(1).Range("C5").Value
        if isempty(erow) then erow.value = "----------"
        wb.Close
        MyFile = Dir
    Loop
End Sub