2016-04-29 32 views
0

同じシート名(ただし順序は異なる)のブックが2つあり、ブックのすべてのシートの情報をコピーしたいと思います。その情報を他のブックのそれぞれのシート(マッチするシート名)に貼り付ける。私はこのコードが軌道に乗っているように感じていますが、これを行うにはもっと効率的な方法があります。同じシート名:シートが一致する場合にコピー&ペースト

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 

答えて

1

私はあなたがコピーしようとする、またはどこどのくらいのデータを確認していない「...など、Windowsのクリップボード内のデータ...の大量があります」のコードが動作しているが、それはのような警告が語りますコピー先のブックで、発行したコードは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)を行っているため、列の書式設定が保持されているため、新しいブックの列幅を再調整する必要はありません。

+0

Cool。 "sh"との素晴らしい代替 –

関連する問題