兩張工作簿，相同的紙張名稱：複製並粘貼，如果紙張匹配

Question

我有兩個工作簿，具有相同的紙張名稱（但順序不同），我想複製一張工作簿的所有紙​​張的信息，並將該信息粘貼到其他工作簿的各個工作表（匹配工作表名稱）中。我覺得這段代碼是正常的，但也許有更高效或更乾淨的方式來做到這一點。代碼工作，但它說，像一個警告「有一個在Windows剪貼板數據......等的大量......」

Sub ActualizarNoticias() 
    Dim aw As Workbook 
    Dim y As Workbook 

Set aw = Application.ActiveWorkbook 
Set y = Application.Workbooks.Open("G:\Estudios\Biblioteca\Mercado Accionario Chileno\BBDD Oficial.xlsm") 


For i = 1 To aw.Sheets.Count 
For j = 1 To y.Sheets.Count 

If aw.Worksheets(i).Name = y.Worksheets(j).Name Then 

y.Worksheets(j).Range("A3").Copy 
aw.Worksheets(i).Range("A100").PasteSpecial 
End If 

Next j 
Next i 

y.close 
' ActualizarNoticias Macro 
' 
' 
End Sub 

Answer 1

我不知道你想有多少數據複製，或在在要複製到的目標工作簿中，但是您發佈的代碼只複製一個單元格（A3）並將其複製到單元格A100中的目標工作簿中。我收集你的代碼只是一個例子，因爲當然，警告不會用於​​複製單個單元。這將有助於獲得您的實際範圍和確切的警告消息，但正如您所說，它正在工作。當您運行代碼或退出工作簿時是否收到消息？如果是後者（我懷疑），那麼你可以簡單地在你的代碼的結束清除剪貼板：

Application.CutCopyMode = False 

您還可以消除一個小詭計第二環：

Set sh = Nothing 
    On Error Resume Next 
    Set sh = y.Worksheets(aw.Worksheets(i).Name) 
    On Error GoTo 0 
    If TypeName(sh) <> "Nothing" Then 
     .... 
    End If 

我整個子程序看起來如下：

Sub CopyWorkbook() 
    Dim aw As Workbook 
    Dim y As Workbook 
    Dim sh As Worksheet 

    Set aw = Application.ActiveWorkbook 
    Set y = Application.Workbooks.Open("C:\work\fusion\expenseTypes.xls.xlsx") 

    For i = 1 To aw.Sheets.Count 
     Set sh = Nothing 
     On Error Resume Next 
     Set sh = y.Worksheets(aw.Worksheets(i).Name) 
     On Error GoTo 0 
     If TypeName(sh) <> "Nothing" Then 
      sh.Range("A:C").Copy aw.Worksheets(i).Range("A1") 
     End If 
    Next i 
    Application.CutCopyMode = False 
End Sub 

我認爲這是最有效的方法。我上面的示例代碼複製了整列（A到C），它們保留了列格式，因此不需要爲列寬重新調整新的工作簿。