0

以下のコード リターンにより、ヘッダーをダッシュ​​ボード ファイルと apac ファイルに一致させ、データをダッシュ​​ボード ファイルと「temp calc」シートにコピーできます。問題は、apac が唯一のファイルではないことです。ウィンドウをポップアップし、このコードをループで実行して、ヘッダーの一致後に「temp calc」で最後に使用された行の後に各ファイルからデータを貼り付けます。私は両方を行うことができません。アドバイスしてください。

ありがとう、

マシュー

Sub copyCol()


     Sheets("Temp Calc").Select

    'Clear existing sheet data except headers
        Rows(1).Offset(1, 0).Resize(Rows.Count - 1).ClearContents



        Dim lastCol, lastRow As Long, k As Long, a As Variant, b As Variant, cmpRng As Range
        Dim mastCol As Long, mastRng As Range, n As Long
        Dim Wbk As Workbook

        Application.ScreenUpdating = False
        Worksheets("Temp Calc").Select

           lastCol = Worksheets("Temp Calc").Cells(1, Columns.Count).End(xlToLeft).Column
           lastRow = Worksheets("Temp Calc").Cells(Rows.Count, 1).End(xlDown).Row

        Set cmpRng = Range(Cells(1, 1), Cells(1, lastCol))
        a = cmpRng
        Set Wbk = Workbooks.Open("G:\work\APAC.xlsx")
        Worksheets("Sheet1").Select
        mastCol = Cells(1, Columns.Count).End(xlToLeft).Column

        Set mastRng = Range(Cells(1, 1), Cells(1, mastCol))
        b = mastRng

        For k = 1 To lastCol
            For n = 1 To mastCol
                If UCase(a(1, k)) = UCase(b(1, n)) Then
                Windows("APAC-Personal Assignment.xlsx").Activate
                    Worksheets("Sheet1").Range(Cells(2, n), Cells(lastRow, n)).Copy
                    Windows("Dashboard_for_Roshan.xlsm").Activate
                    Worksheets("Temp Calc").Select
                    Cells(2, k).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                    False, Transpose:=False

                    Exit For
                End If
            Next
        Next

        Application.ScreenUpdating = True

        Exit Sub

    End Sub
4

1 に答える 1

1

提案されたコード (以下) を実装することをお勧めします。目標は、A)複数選択オプションを使用してファイルを開くダイアログを表示する、B) [ OK] を押すと、選択したすべてのファイルが開き ( C)閉じます)。

あなたのコードでソリューションに参加できると思います。実行する前に、コードを試して、それがどのように機能するかを理解してください。

Sub Solution_for_multifiles()

    Dim SelectedFiles As Object
    Set SelectedFiles = Application.FileDialog(msoFileDialogFilePicker)
        SelectedFiles.Show

    If SelectedFiles.SelectedItems.Count <> 0 Then
        'here is the code which will run for all files selected
        Dim fileOne
        Dim Wbk As Workbook
        For Each fileOne In SelectedFiles.SelectedItems
            Set Wbk = Workbooks.Open(fileOne)
            'your code here...
            '.........

            'remeber to close before move to next file
            Wbk.Close
        Next

    Else
        MsgBox "No file was selected...", vbOKOnly + vbCritical, "Error!"
        Err.Clear
    End If
End Sub
于 2013-06-26T07:13:11.733 に答える