Как скопировать данные из одного файла Excel нескольких листов в другой файл Excel нескольких листов - PullRequest
0 голосов
/ 16 ноября 2018

У меня есть один файл Excel из нескольких листов с именами столбцов, значениями и именами листов.
У меня есть другой файл Excel с несколькими листами с именами столбцов и именами листов.
Я хочу скопировать данные (значения столбцов) из одного Excel в другое Excel без изменения имен листов, поскольку имена листов отличаются, но имена столбцов совпадают.
Рад слышать некоторые предложения.

1 Ответ

0 голосов
/ 16 ноября 2018

Мое предложение - определить функции в отдельных модулях, но здесь для простоты я определил 2 функции в основном модуле (активация рабочей книги и рабочей таблицы). Макрос находится в отдельном файле Excel (Macro.xlsm). Два файла Excel (Book1.xlsx и Book2.xlsx) включены в одно и то же местоположение.

enter image description here

Я попытался дать общий ответ на этом примере, чтобы его можно было расширить для многих рабочих книг и рабочих листов.

enter image description here

Book2.xlsx перед запуском макроса.

enter image description here

Book2.xlsx после запуска макроса. Целевая строка была специально выбрана на одну строку ниже: -)

enter image description here

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...