0

ユーザーが複数の Excel ファイルを参照して選択できるようにするマクロがあります。ユーザーが複数の Excel ファイルを選択した後、複数の Excel ファイルのコンテンツを現在アクティブなワークブックの 1 つのシートに保存する必要があります。コンテンツは互いに追加されます。

問題は、ループが 2 回目に実行されたときに、範囲に問題があるということです。範囲は「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 に答える