web-dev-qa-db-ja.com

別のブック（Excel）からデータをコピーする方法は？

私はすでにシートや他のものを作成するマクロを持っています。シートが作成された後、2番目のExcel（開いている）から最初のアクティブなExcelファイルにデータをコピーする別のマクロを呼び出したいですか。

最初にヘッダーにコピーしたいのですが、それを機能させることができません-エラーが発生し続けます。

Sub CopyData(sheetName as String)
  Dim File as String, SheetData as String

  File = "my file.xls"
  SheetData = "name of sheet where data is"

  # Copy headers to sheetName in main file
  Workbooks(File).Worksheets(SheetData).Range("A1").Select  # fails here: Method Select for class Range failed
  Workbooks(File).Worksheets(SheetData).Range(Selection, Selection.End(xlToRight)).Select
  Workbooks(File).Worksheets(SheetData).Selection.Copy ActiveWorkbook.Sheets(sheetName).Cells(1, 1)
End Sub

なにが問題ですか ？

「myfile.xls」をアクティブにする必要は本当にありません。

編集：それが機能する前に、私はそれをあきらめて、SheetDataを新しいシートとしてターゲットファイルにコピーする必要がありました。 複数の行を検索して選択

excelvbaexcel-vba
6
Kim

2年後（これはグーグルで見つけたので、他の人にとっては）...上で述べたように、何も選択する必要はありません。これらの3行：

Workbooks(File).Worksheets(SheetData).Range("A1").Select
Workbooks(File).Worksheets(SheetData).Range(Selection, Selection.End(xlToRight)).Select
Workbooks(File).Worksheets(SheetData).Selection.Copy ActiveWorkbook.Sheets(sheetName).Cells(1, 1)

と置き換えることができます

Workbooks(File).Worksheets(SheetData).Range(Workbooks(File).Worksheets(SheetData). _
Range("A1"), Workbooks(File).Worksheets(SheetData).Range("A1").End(xlToRight)).Copy _
Destination:=ActiveWorkbook.Sheets(sheetName).Cells(1, 1)

これにより、選択エラーを回避できます。

2
Iain Wareing

ベストプラクティスは、ソースファイルを開いて（煩わしくない場合は誤って表示されたステータスで）データを読み取り、それを閉じます。

以下のリンクから、機能するクリーンなコードを入手できます。

http://vba-useful.blogspot.fr/2013/12/how-do-i-retrieve-data-from-another.html

2
user3188123

画面に影響がなければ、「myfile.xls」をアクティブにしていただけませんか。画面の更新をオフにすることはこれを実現する方法であり、パフォーマンスも向上します（ワークシート/ワークブックを切り替えながらループを実行している場合は重要です）。

これを行うためのコマンドは次のとおりです。

    Application.ScreenUpdating = False

マクロが終了したら、忘れずにTrueに戻してください。

1
Sam Meldrum

VBAを使用して、あるワークブックから別のワークブックにデータをコピーする必要がありました。要件は以下のとおりです。1。ActiveXボタンを押すと、ダイアログを開いて、データのコピー元のファイルを選択します。 2. [OK]をクリックすると、値がセル/範囲から現在作業中のブックにコピーされます。

煩わしいワークブックを開くので、open機能を使いたくありませんでした。

以下は私がVBAで書いたコードです。改善や新しい代替案は大歓迎です。

コード：ここでは、A1：C4コンテンツをブックから現在のブックのA1：C4にコピーしています。

    Private Sub CommandButton1_Click()
        Dim BackUp As String
        Dim cellCollection As New Collection
        Dim strSourceSheetName As String
        Dim strDestinationSheetName As String
        strSourceSheetName = "Sheet1" 'Mention the Source Sheet Name of Source Workbook
        strDestinationSheetName = "Sheet2" 'Mention the Destination Sheet Name of Destination Workbook


        Set cellCollection = GetCellsFromRange("A1:C4") 'Mention the Range you want to copy data from Source Workbook

        With Application.FileDialog(msoFileDialogOpen)
            .AllowMultiSelect = False
            .Show
            '.Filters.Add "Macro Enabled Xl", "*.xlsm;", 1

            For intWorkBookCount = 1 To .SelectedItems.Count
                Dim strWorkBookName As String
                strWorkBookName = .SelectedItems(intWorkBookCount)
                For cellCount = 1 To cellCollection.Count
                    On Error GoTo ErrorHandler
                    BackUp = Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount))
                    Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = GetData(strWorkBookName, strSourceSheetName, cellCollection.Item(cellCount))
                    Dim strTempValue As String
                    strTempValue = Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)).Value
                    If (strTempValue = "0") Then
                        strTempValue = BackUp
                    End If
Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = strTempValue 
ErrorHandler:
                    If (Err.Number <> 0) Then
                            Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = BackUp
                        Exit For
                    End If
                Next cellCount
            Next intWorkBookCount
        End With

    End Sub

    Function GetCellsFromRange(RangeInScope As String) As Collection
        Dim startCell As String
        Dim endCell As String
        Dim intStartColumn As Integer
        Dim intEndColumn As Integer
        Dim intStartRow As Integer
        Dim intEndRow As Integer
        Dim coll As New Collection

        startCell = Left(RangeInScope, InStr(RangeInScope, ":") - 1)
        endCell = Right(RangeInScope, Len(RangeInScope) - InStr(RangeInScope, ":"))
        intStartColumn = Range(startCell).Column
        intEndColumn = Range(endCell).Column
        intStartRow = Range(startCell).Row
        intEndRow = Range(endCell).Row

        For lngColumnCount = intStartColumn To intEndColumn
            For lngRowCount = intStartRow To intEndRow
                coll.Add (Cells(lngRowCount, lngColumnCount).Address(RowAbsolute:=False, ColumnAbsolute:=False))
            Next lngRowCount
        Next lngColumnCount

        Set GetCellsFromRange = coll
    End Function

    Function GetData(FileFullPath As String, SheetName As String, CellInScope As String) As String
        Dim Path As String
        Dim FileName As String
        Dim strFinalValue As String
        Dim doesSheetExist As Boolean

        Path = FileFullPath
        Path = StrReverse(Path)
        FileName = StrReverse(Left(Path, InStr(Path, "\") - 1))
        Path = StrReverse(Right(Path, Len(Path) - InStr(Path, "\") + 1))

        strFinalValue = "='" & Path & "[" & FileName & "]" & SheetName & "'!" & CellInScope
        GetData = strFinalValue
    End Function
0
cSharpDirective

何も選択する必要はないと思います。 2つの空白のワークブックBook1とBook2を開き、Book2のSheet1のRange（ "A1"）に値 "A"を入力し、次のコードを即時ウィンドウに送信しました-

Workbooks（2）.Worksheets（1）.Range（ "A1"）。Copy Workbooks（1）.Worksheets（1）.Range（ "A1"）

Book1のSheet1のRange（ "A1"）に "A"が含まれるようになりました。

また、コードでActiveWorkbookから「myfile.xls」にコピーしようとしているという事実を考えると、CopyメソッドはActiveWorkbookの範囲と宛先に適用する必要があるため、順序が逆になっているようです（引数コピー機能）は、「myfile.xls」の適切な範囲である必要があります。

0
Anindya