如果作業表名稱匹配，則將資料從資料作業簿傳輸到目標作業簿

如果兩個作業簿的作業表名稱匹配，我正在嘗試將一系列資料從一個 Excel 作業簿傳輸到另一個作業簿。但是，我的代碼似乎有一些問題。

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

uj5u.com熱心網友回復：

這里有幾件事丟失/出錯。首先，您缺少On Error Resume Next回圈內部，就在檢查 sheet 是否存在的部分之前。其次，你正在嘗試Set一個，這是Worksheet object不可能的，你想要Dim一個ws 物件，然后是它（我已經為此添加了）。最后，您正在檢查是否is ，但這就是作業簿。我們需要檢查作業表，即。Setws2wb2Nothingws2

有調整的代碼（前面有雙反引號的評論是我的）：

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

標籤：擅长 vba

上一篇：我的Kalilinux顯示“沒有名為importlib的模塊”“來自importlib匯入import_module”

下一篇：在ExcelVBA中查看突出顯示的選定行文本時，如何禁用和啟用條件格式（“洗掉線和紅色文本”）？