Two workbooks, Same Sheets Names: Copy and Paste if Sheets are matched

Question

I have two workbooks, with same sheets name (but in different order), and I'd like to copy info of all of the sheets of one workbook, and pasting that info in the respective sheet of the other workbook (matching sheet names). I feel like this code is on track, but maybe there is a more efficient or cleaner way to do this. Code is working, but it says a warning like " there's a big amount of data in the windows clipboard... etc... "

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

I am not sure how much data you intend to copy, or where in the target workbook you want to copy to, but the code you posted only copies one cell (A3) and copies it into the target workbook in cell A100. I gather your code is only an example, because surely the warning would not come for copying a single cell. It would help to have your actual ranges, and exact warning message, but as you said, it's working. Are you getting the message when you run the code, or when you exit the workbook? If the latter (as I suspect), then you can simply clear the clipboard at the end of your code:

    Application.CutCopyMode = False

You can also eliminate the second loop with a little trickery:

    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

My entire subroutine looks as follows:

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

I think this is the most efficient way to do it. My sample code above copies entire columns (A through C), which preserves column formatting, so that it's not necessary to re-adjust your new workbook for the column widths.