如何将数据从多个工作表的一个Excel文件复制到多个工作表的另一个Excel文件中

Question

I have one excel file of multiple sheets with column names and values and sheetnames.
I have another excel file of multiple sheets with column names and sheet names.
I want to copy the data (column values) from one excel to another excel without changing the sheetnames, since the sheetnames are different, but the column names are same.
Pleased to hear some suggestions.

Answer 1

My suggestion is to define functions in separate modules but here I defined 2 functions in the main module (activating of workbook and worksheet) for simplicity. The macro is on separate excel file (Macro.xlsm). There are two excel files (Book1.xlsx & Book2.xlsx) included in the same location.

I tried to answer generally with this example so it can be extended for many workbooks and worksheets.

Book2.xlsx before running the macro.

Book2.xlsx after running the macro. The destination row was selected one row lower intentionally :-)

Option Explicit

Dim wb01 As Workbook, wb02 As Workbook
Public paTh01 As Variant, paTh02 As Variant


'/Define your functions
'Function1 openBook(paTh0, wB0)
Function openBook(path0 As Variant, wB0 As Workbook)
        Set wB0 = Workbooks.Open(path0)
        wB0.Activate
End Function

'Function2 openSheet(wB0, "Sheet_Name")
Function openSheet(wB0 As Workbook, sheetName0 As String)
        wB0.Activate
        Sheets(sheetName0).Activate
End Function

'Main Module
Sub main()

    paTh01 = "D:\Book1.xlsx"
    paTh02 = "D:\Book2.xlsx"

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    Call openBook(paTh01, wb01)
    Call openSheet(wb01, "mySheet1")
    Range("A2:D4").Select
    With Selection
        .Orientation = 0
        .Copy
    End With

    'If you have a loop, you should put delay otherwise excel will crash
    Application.Wait (Now + TimeValue("0:00:01"))

    Call openBook(paTh02, wb02)
    Call openSheet(wb02, "mySheet2")
    Range("A3:D5").PasteSpecial xlPasteValues, Transpose:=False


    wb01.Close savechanges:=False
    DoEvents

    wb02.Close savechanges:=True
    DoEvents

End Sub