0

The below code return allows me to match header with my dashboard file and apac file and copy data into dashboard file and "temp calc" sheet.the problem is that apac is not the only file, i need to be able to select files through a pop up window and run this code on a loop so that it will paste data from each file after the last used row in "temp calc" after matching headers. I'am unable to do both, please advise ?

Thanks,

Mathew

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)按确定后它将打开(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 回答