Excel VBA - 从列表中的工作表复制粘贴

Question

I have a somewhat easy situation, but I lack the VBA knowledge to automate this process.

In an Excel file called "Macro", I have a relation (column A and B) of sheets from two different workbooks I want to copy/paste values from/to. I want to be able to run a macro that selects and opens the two workbooks, loops through the sheet list of workbook 1, copy the selected range (same for all sheets) and paste it in its correspondent sheet of workbook 2.

For example:

I need to open Workbooks 1 and 2 (selected by the user), and copy values from sheet ABC to sheet XYZ, DEF to UVW...and so on

Workbook 1	Workbook 2
Sheet ABC	Sheet XYZ
Sheet DEF	Sheet UVW

Hope this was clear. Any help is appreciated!

Answer 1

Put your table on sheet1 with upper left corner in cell A1. Configure the constant RNG_TO_COPY to your range.

Option Explicit
sub copyrange()

    Dim RNG_TO_COPY As String

    Dim ws As Worksheet, wb(2) As Workbook
    Dim dict(2), filename(2) As String, s(2) As String
    Dim iLastRow As Long, r As Long
    Dim n As Integer, msg As String

    ' open workbooks and compile list of worksheet names
    For n = 1 To 2
        s(n) = GetFile(n)
        If Len(s(n)) > 0 Then
            Set dict(n) = CreateObject("Scripting.Dictionary")
            Set wb(n) = Workbooks.Open(s(n))
            For Each ws In wb(n).Sheets
                dict(n).Add ws.Name, ws.Index
            Next
        Else
           Exit Sub
        End If
    Next
      
    ' check data valid
    Set ws = ThisWorkbook.Sheets(1)
    iLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    For r = 2 To iLastRow
        For n = 1 To 2
            s(n) = ws.Cells(r, n)
            If Not dict(n).exists(s(n)) Then
                msg = msg & vbCrLf & "'" & s(n) & "' in " & wb(n).Name
            End If
        Next
    Next

    ' errors
    If msg <> "" Then
        MsgBox "Sheets do not exist" & msg, vbCritical
        GoTo finish
    End If

    ' copy ranges
    For r = 2 To iLastRow
        s(1) = ws.Cells(r, 1)
        s(2) = ws.Cells(r, 2)
        RNG_TO_COPY = ws.Cells(r, 3)
        wb(1).Sheets(s(1)).Range(RNG_TO_COPY).Copy wb(2).Sheets(s(2)).Range(RNG_TO_COPY)
    Next

    MsgBox "Finished copying from " & wb(1).Name & " to " & wb(2).Name, vbInformation

finish:
    wb(1).Close False
    wb(2).Close True

End Sub
Function GetFile(n As Integer) As String
    Dim f
    Set f = Application.FileDialog(msoFileDialogFilePicker)
    With f
        .Title = "Select File " & n
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then Exit Function
        GetFile = .SelectedItems(1)
    End With
End Function