如果 sheet 名称匹配，则将数据从数据工作簿传输到目标工作簿

Question

我正在尝试将一系列数据从一个 excel 工作簿传输到另一个工作簿，前提是两个工作簿的 sheet 名称匹配。但是，我的代码似乎存在一些问题。

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

Answer 1

这里有几件事 missing/going 错了。首先，您在循环内缺少 On Error Resume Next，就在 checks if sheet exists 部分之前。其次，你试图Set一个Worksheet object，这是不可能的，你想Dim一些东西作为一个ws对象然后Set 它（我为此添加了 ws2 ）。最后，您要检查 wb2 是否为 Nothing，但那是工作簿。我们需要检查工作sheet，即ws2.

经过调整的代码（前面有双反引号的注释是我的）：

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

如果 sheet 名称匹配，则将数据从数据工作簿传输到目标工作簿

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

excel

vba