0

我有一个允许用户浏览和选择多个 Excel 文件的宏，在用户选择了多个 Excel 文件后，多个 Excel 文件中的内容应保存在当前活动工作簿上的一张纸上。内容将相互附加。

问题是当循环第二次运行时它抱怨范围，它说范围应该从“A1”开始。

下面是我的代码。

Sub Button3_Click()
Dim fileStr As Variant
Dim incount As Integer
Dim wbk1 As Workbook, wbk2 As Workbook

incount = 1

fileStr = Application.GetOpenFilename(FileFilter:="microsoft excel files (*.xlsx), *.xlsx", Title:="Get File", MultiSelect:=True)

    For i = 1 To UBound(fileStr)
        MsgBox fileStr(i), , GetFileName(CStr(fileStr(i)))
        Set wbk1 = ActiveWorkbook
        Set wbk2 = Workbooks.Open(fileStr(i))

        wbk2.Sheets(1).Cells.Copy wbk1.Worksheets("Sheet3").Cells(incount, 1)

        incount = Range("A" & Rows.Count).End(xlUp).Row

        wbk2.Close
    Next i

    MsgBox incount

End Sub
Function GetFileName(fileStr As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    GetFileName = fso.GetFileName(fileStr)

End Function

错误信息：

Run-time error '1004'

To paste all cells from an Excel worksheet into the current worksheet,
you must paste into the first cell(A1 or R1C1)
4

1 回答 1

0

cells.copy将整个数据表复制到“incount”行，这意味着在已粘贴数据下方的“整个源表”的目标位置没有空间

试试下面的代码，它会删除 incount 并获取 UsedRange：

Sub Button3_Click()
Dim fileStr As Variant
Dim wbk1 As Workbook, wbk2 As Workbook
Dim ws1 As Worksheet

fileStr = Application.GetOpenFilename(FileFilter:="microsoft excel files (*.xlsx), *.xlsx", Title:="Get File", MultiSelect:=True)

Set wbk1 = ActiveWorkbook
Set ws1 = wbk1.Sheets("Sheet3")

For i = 1 To UBound(fileStr)
    MsgBox fileStr(i), , GetFileName(CStr(fileStr(i)))

    Set wbk2 = Workbooks.Open(fileStr(i))

    wbk2.Sheets(1).UsedRange.Copy ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 1, 1)
    wbk2.Close
Next i

End Sub
Function GetFileName(fileStr As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    GetFileName = fso.GetFileName(fileStr)
End Function
于 2012-10-14T17:19:12.247 回答