Question

我写过这个并且它在很大程度上起作用...对于我找到的第一个文件。在第二个文件中，我收到以下错误：

“无法粘贴信息，因为复制区域和粘贴区域的大小和形状不同。请尝试以下操作之一：

单击一个单元格，然后粘贴。
选择一个矩形相同的大小和形状，然后粘贴。“

我不明白我做错了什么。

假设遍历一个目录并获取那里的所有.txt文件并将它们导入Sheet1或Sheet2。我可以让第一个导入正常，但下一个文件会抛出该错误而不是附加到同一个电子表格。

Sub PopulateSheets()

    Dim file As String, path As String, fullpath As String, StaticPath As String
    Dim count As Integer
    Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet
    Dim Sheet As String
    Dim RowCount As Long
    On Error GoTo Errorcatch

    RowCount = 1
    count = 1
    StaticPath = Sheet3.Cells(2, 7)
    While (count <= 2)

        If count = 1 Then
            path = StaticPath & "\com\*.txt"
        Else
            path = StaticPath & "\res\*.txt"
        End If
        file = Dir(path)
        Sheet = "Sheet" & count
        While (file <> "")
            fullpath = Left(path, InStr(1, path, "*.txt") - 1) & file
            Set wbI = ThisWorkbook
            Set wsI = wbI.Sheets(Sheet) '<~~ Sheet where I want to import
            Set wbO = Workbooks.Open(fullpath)
            RowCount = wsI.Range("A:A").CurrentRegion.Rows.count
            wbO.Sheets(1).Cells.Copy Destination:=wsI.Range("A" & RowCount)
            wbO.Close SaveChanges:=False
            file = Dir 'Grab Next File
        Wend
        count = count + 1
    Wend
Exit Sub

Errorcatch:
MsgBox Err.Description

End Sub

在粘贴第一个文件中的信息后关闭它，然后尝试粘贴第二个文件，它在wbO.Sheets(1).Cells.Copy Destination:=wsI.Range("A" & RowCount)处爆炸。

此时我们将不胜感激。

旁注我注意到如果我将wbO.Sheets(1).Cells.Copy Destination:=wsI.Range("A" & RowCount)与wbO.Sheets(1).Cells.Copy wsI.Cells交换，它会将所有文件粘贴到工作表中......但它会覆盖之前的文件。我需要它来追加并且不确定如何实现这一点。

Answer 1

您没有“重置”path的值。如果你的路径是“C：\ MyFolder”（例如），第一次循环，你的path是

“C：\ MyFolder文件\ COM \ * TXT”

再次循环时，路径变为......

“C：\ MyFolder文件\ COM \ * TXT \ RES \ * TXT”

...创建无效路径。按照以下更新代码。

count = count + 1
' ADD THE LINE BELOW TO YOUR CODE
path = Sheet3.Cells(2, 7)

Answer 2

我通过将While（File＆lt;＆gt;“”）循环中的逻辑交换为：

来回答我自己的问题

       fullpath = Left(path, InStr(1, path, "*.txt") - 1) & file
        Set wbO = Workbooks.Open(fullpath)
        RowCount = wsI.UsedRange.Rows.count
        SourceRowCount = wbO.Sheets(1).Range("A:A").CurrentRegion.Rows.count
        If RowCount <> 1 Then
            RowCount = RowCount + 2
            SourceRowCount = RowCount + SourceRowCount
        End If
        wbO.Sheets(1).Range("$A$1:$n$" & SourceRowCount).Copy Destination:=wsI.Range("A" & RowCount & ":$n$" & SourceRowCount)
        wbO.Close SaveChanges:=False
        file = Dir 'Grab Next File`

我的行数每次增加两个，这样我的导入之间就有一个空格。现在一切正常。

将多个空格分隔的文件导入一个Excel工作表

2 个答案: