VBA无法使用单个值复制和粘贴单元格

我有一个代码，可以循环遍历文件夹中的excel文件，复制值并将其粘贴到新工作簿中

当单元格中的文件只有一个值时，就会出现问题。它返回一个错误声明

复制区域和粘贴区域的大小不同

下面是我的代码：

Sub MergeDataFromWorkbooks()
    'DECLARE AND SET VARIABLES
    Dim wbk As Workbook
    Dim wbk1 As Workbook
    Set wbk1 = ThisWorkbook

    Dim Filename As String
    Dim Path As String
    Path = "C:\Users\Desktop\merge all to one\" 'CHANGE PATH ACCORDING TO FOLDER DIRECTORY LEAVING \ AT THE END
    Filename = Dir(Path & "*.xlsx")

    '--------------------------------------------
    'OPEN EXCEL FILES
    Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
        Set wbk = Workbooks.Open(Path & Filename)
        wbk.Activate
        Range("A2").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Windows("Book1.xlsm").Activate
        Application.DisplayAlerts = False

        Dim lr As Double
        lr = wbk1.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

        Sheets(1).Select
        Cells(lr + 1, 1).Select
        ActiveSheet.Paste
        wbk.Close True
        Filename = Dir
    Loop

    MsgBox "All the files are copied and pasted in Book1."
End Sub

首先，要改进编码风格

您应该避免使用

选择

、

选择

和

激活

，因为这是一种不好的做法，会大大降低代码的速度。您可以不使用它们来执行所有操作。在大多数情况下，你不应该使用它们（只有很少的特殊情况）

在未指定工作表的情况下，不要使用例如

范围

或

单元格

。否则Excel会尝试猜测您指的是哪一张工作表，它很可能无法做到这一点。猜测是不知道的，因此总是告诉Excel你指的工作表是什么，比如

工作表（1）。范围
或
工作表（“SheetName”）。范围

使用描述性变量名。像

wbk

和

wbk1

这样的名字不是很有描述性，后来你就不知道

wbk1

是什么，把事情搞砸了。改为使用像

wbDestination

和

wbSource

这样的东西，现在大家都知道这意味着什么了。
另外，在接近第一次使用时声明变量可能是一个很好的实践，尤其是当代码变长时

如果可能，请始终使用

工作表

而不是

工作表

<代码>工作表不仅包含工作簿，而且在大多数情况下，您只需要

工作表

。你说没关系？是的<代码>工作表（1）。如果第一张工作表是图表，范围将抛出错误。我们可以避免这种情况

现在让我们开始整理… 选择3次并复制，而不是激活

wbk.Activate
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

我们可以直接复制，而无需任何ativate或select，其速度更快且具有相同的效果：

With wbSource.Worksheets(1).Range("A2")
    'copy without select
    .Resize(.End(xlDown).Row - .Row + 1, .End(xlToRight).Column - .Column + 1).Copy
End With

---

当我们关闭源工作簿时

wbSource.Close SaveChanges:=False

我们不需要保存更改，因为我们没有更改任何内容。这样更安全，速度更快

因此，我们以 确定源文件中最后使用的单元格（列和行）的替代方法 当第2行是最后使用的行时，这样可以避免错误

With wbSource.Worksheets(1).Range("A2")
    .Resize(.Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).Row - .Row + 1, .Parent.Cells(.Row, .Parent.Columns.Count).End(xlToLeft).Column - .Column + 1).Copy
End With

说明：

.Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).Row

---

通过从Excel中最后一个单元格开始并向上（如按ctrl+up）查找列A中最后使用的行。

我不明白为什么会抛出代码，因为复制区域和粘贴区域的大小不相同。除非有合并的单元格

Select和Active通常用于向用户显示某些内容。除非绝对必要，否则您可以也不应该使用它们。我建议观看：

---

实际上，它并没有解决这个问题，它仍然存在这样一个问题：我可以复制多行单元格值的工作表，但不能复制只有一行单元格的工作表value@wt1155除非有任何合并的单元格，否则您在问题中描述的错误不应该出现。我想我将提供我的datatry

.Resize的屏幕截图（.Parent.Cells（.Parent.Rows.Count，.Column）.End（xlUp）.Row-.Row+1，.Parent.Cells（.Row，.Parent.Columns.Count）.End（xlToLeft）.Column-.Column+1）.Copy

代替。这里的问题是理论上第一个代码的作用与：选择A2并按Ctrl+Shift+Down。如果您在该文件上手动执行此操作，它将从A2选择到A1048576，这几乎是正确的。但新代码的作用是：选择A1048576并按Ctrl+Up，这样它只会选择A2。这只是找到最后一次使用的更好方法我想是d单元。（专栏也一样）

.Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).Row

Dim Source As Range
Application.DisplayAlerts = False
Do While Len(Filename) > 0                        'IF NEXT FILE EXISTS THEN

    With Workbooks.Open(Path & Filename)
        Set Source = .Range(.Range("A" & .Rows.Count).End(xlUp), .Cells(1, 
        .Columns.Count).End(xlToLeft))
    End With

    Source.Copy Workbooks("Book1.xlsm").Range("A" & .Rows.Count).End(xlUp)
    .Close False
    Filename = Dir
Loop