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!
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.