Transfer Data from from data workbook to destination workbook if sheet name matches

Question

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

score 1 · Accepted Answer · answered May 08 '22 at 08:26

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

How can I add another range ("J16:J38") and transfer it to B28 of destination worksheet? what would be the code? — Samiul, May 08 '22 at 09:48
Underneath `With ws.Range("G16:G38") ... End With`, just add another such block (still before the `End If`). In this new block, change `"G16:G38"` to `"J16:J38"`, and `ws2.Range("D28")` to `ws2.Range("B28")` — ouroboros1, May 08 '22 at 10:52

Transfer Data from from data workbook to destination workbook if sheet name matches

1 Answers1