I am trying to transfer a range of data from one excel workbook to another workbook if sheet name of both the workbook matches. However, There seems to be some problem with my code.
Sub Button20_Click()
Dim file1 As Variant
Dim wb1 As Workbook
Dim file2 As Variant
Dim wb2 As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
' Browse for data file and open it
file1 = Application.GetOpenFilename(Title:="Browse for your Data File", FileFilter:="Excel
Files (*.xls*),*xls*")
If file1 <> False Then
Set wb1 = Application.Workbooks.Open(file1)
End If
' Browse for template file and open it
file2 = Application.GetOpenFilename(Title:="Browse for your Template File",
FileFilter:="Excel Files (*.xls*),*xls*")
If file2 <> False Then
Set wb2 = Application.Workbooks.Open(file2)
End If
' Loop through all sheets in data file and copy over to template file
For Each ws In wb1.Worksheets
Set wb2.Sheets(ws.Name) = wb1.Sheets(ws.Name)
On Error GoTo 0 'stop ignoring errors
'any match?
If Not wb2 Is Nothing Then
'Transfer values
With ws.Range("G16:G38")
wb2.Range("D28").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End If
Set wb2 = Nothing 'set up for next iteration if any
Next ws
MsgBox "Macro complete!"
End Sub
CodePudding user response:
Couple of things missing/going wrong here. First, you are missing an On Error Resume Next
inside the loop, just before the part that checks if sheet exists. Second, you are trying to Set
a Worksheet object
, which is impossible, you want to Dim
something as a ws object and then Set
it (I've added ws2
for this). Finally, you are checking whether or not wb2
is Nothing
, but that's the workbook. We need to check the worksheet, i.e. ws2
.
Code with adjustments (comments with double backticks in front are mine):
Sub Button20_Click()
Dim file1 As Variant
Dim wb1 As Workbook
Dim file2 As Variant
Dim wb2 As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet '' to be set in loop
Application.ScreenUpdating = False
' Browse for data file and open it
file1 = Application.GetOpenFilename(Title:="Browse for your Data File", FileFilter:="Excel Files (*.xls*),*xls*")
If file1 <> False Then
Set wb1 = Application.Workbooks.Open(file1)
End If
' Browse for template file and open it
file2 = Application.GetOpenFilename(Title:="Browse for your Template File", FileFilter:="Excel Files (*.xls*),*xls*")
If file2 <> False Then
Set wb2 = Application.Workbooks.Open(file2)
End If
' Loop through all sheets in data file and copy over to template file
For Each ws In wb1.Worksheets
''insert error handling method
On Error Resume Next
''Set wb2.Sheets(ws.Name) = wb1.Sheets(ws.Name) '' this is impossible, instead use:
Set ws2 = wb2.Sheets(ws.Name)
On Error GoTo 0 'stop ignoring errors
'any match?
''If Not wb2 Is Nothing Then '' we need the worksheet, not the workbook
If Not ws2 Is Nothing Then
'Transfer values
With ws.Range("G16:G38")
'' wb2.Range("D28").Resize(.Rows.Count, .Columns.Count).Value = .Value '' again: ws, not wb
ws2.Range("D28").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End If
'' Set wb2 = Nothing 'set up for next iteration if any '' we need worksheet
Set ws2 = Nothing
Next ws
MsgBox "Macro complete!"
End Sub