Excel VBA粘贴错误“…是不一样的大小…”

注：我是全新的VBA和一般的代码

我试图制作一个macros来整理来自多个工作簿的数据并将其导入到主工作簿（“ZMaster”）中。

以下代码成功地将单元格C5中的数据复制到多个工作簿中（从文件C：\ AutoMelinh），并将它们粘贴到“ZMaster”工作簿中的一列中。

问题是我得到的错误“你粘贴的数据是不一样的大小作为您的select。 你要不要粘贴？“ 这是在每个粘贴之后，所以我必须每次点击“确定”。 被复制的单元格的格式被合并（在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