0

I have wrote this and it works for the most part...for the first file I find. on the second file, I get the following error:

"The information cannot be pasted because the Copy area and the paste area are not the same size and shape. Try one of the following:

  • Click a single cell, and then paste.
  • Select a rectangle that's the same size and shape, and then paste."

I don't understand what i'm doing wrong.

It is suppose to traverse a directory and grab all the .txt files that are there and import them into either Sheet1 or Sheet2. I can get the first one to import fine, but the next file throws that error instead of appending to the same spreadsheet.

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

It blows up at wbO.Sheets(1).Cells.Copy Destination:=wsI.Range("A" & RowCount) after it has pasted the information from the first file, closed it, then tries to paste the second file.

Any help would be appreciated at this point.

Side note I have noticed that if I swapwbO.Sheets(1).Cells.Copy Destination:=wsI.Range("A" & RowCount) with wbO.Sheets(1).Cells.Copy wsI.Cells , it will paste all of the files into the sheet...but it overwrites the file before it. I need it to append and not sure how to make that happen.

4

2 回答 2

0

您不会“重置” 的值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)
于 2013-07-18T21:13:20.863 回答
0

我通过交换 While (File <> "") 循环中的逻辑来回答我自己的问题：

       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`

我每次将行数加两，以便在导入之间有一个空格。现在一切正常。

于 2013-07-19T15:09:10.753 回答