Question

以下代码返回允许我将标题与我的仪表板文件和apac文件匹配，并将数据复制到仪表板文件和“临时计算”表。问题是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

Answer 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

通过弹出窗口选择.xlsx文件并从中复制数据并在循环上最后一次使用的行之后粘贴它们

1 个答案: