Скопируйте данные с указанного листа открытой рабочей книги и вставьте их на другой указанный лист закрытой рабочей книги.

Question

Я хотел бы скопировать данные из указанного листа в открытой рабочей книге на другой указанный лист в закрытой рабочей книге.
У меня есть такой код:

Private Sub CommandButton1_Click()

    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lCopyLastRow As Long
    Dim lDestLastRow As Long

    'Set variables for copy and destination sheets
    Set wsCopy = Workbooks("Form Marketing Calendar1.xlsm").Worksheets("Form Single")
    Set wsDest = Workbooks.Open("Database Marketing Calendar.xlsx").Worksheets("Sheet1")

    '2. Find first blank row in the destination range based on data in column A
    'Offset property moves down 1 row
    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row

    '3. Copy & Paste Data
    wsCopy.Range("B22:AF25").Copy
    wsDest.Range("B" & lDestLastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
    wsCopy.Range("B26:AF30").Copy
    wsDest.Range("G" & lDestLastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
    Selection.ClearContents
    wsDest.Parent.Close True

End Sub

На самом деле он скопировал данные, но сначала должен открыть файл назначения, а затем автоматически закрыть его.

Также копируются только первые данные (это: wsCopy.Range("B22:AF25").Copy), но вторые данные не копируются (это: wsCopy.Range("B26:AF30").Copy).

Answer 1

Здесь:

Option Explicit
Private Sub CommandButton1_Click()

    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lCopyLastRow As Long
    Dim lDestLastRowB As Long
    Dim lDestLastRowG As Long

    'It is not possible to get data from a workbook without openning it, but this is the closest
    With Application
        .ScreenUpdating = False 'won't show any changes on your screen
        .Visible = Flase 'will hide Excel. CAUTION: if the macro fails make sure to change this back to True
    End With

    'Set variables for copy and destination sheets
    Set wsCopy = Workbooks("Form Marketing Calendar1.xlsm").Worksheets("Form Single")
    Set wsDest = Workbooks.Open("Database Marketing Calendar.xlsx").Worksheets("Sheet1")

    '2. Find first blank row in the destination range based on data in column A
    'Offset property moves down 1 row
    With wsDest 'with allows you to refer to the variable without writting it
        lDestLastRowB = .Cells(.Rows.Count, "B").End(xlUp).Row + 1 'You can use also +1 since it's a number
        'you are not copying the same amount of rows, so maybe the data won't be on the same row on both columns
        lDestLastRowG = .Cells(.Rows.Count, "G").End(xlUp).Row + 1
    End With

    '3. Copy & Paste Data
    wsCopy.Range("B22:AF25").Copy
    wsDest.Range("B" & lDestLastRowB).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
    wsCopy.Range("B26:AF30").Copy
    wsDest.Range("G" & lDestLastRowG).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
    'when you manually copy and paste you will see that the paste range gets selected. This line erases selected content so this is deleting it
    'Selection.ClearContents
    wsDest.Parent.Close True

    With Application
        .ScreenUpdating = True
        .Visible = True
    End With

End Sub

Answer 2

Я обновил свой код, но файл все еще открыт.Как сделать этот процесс бесшовным, чтобы он не открывал файл назначения?

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim wbDest As Workbook
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

Application.ScreenUpdating = False

'Set variables for copy and destination sheets
Set wbDest = Workbooks.Open("D:\OneDrive - NUTRIFOOD INDONESIA\Probation 2\Marketing Calendar X Performance Flash Sale\Database Marketing Calendar.xlsx")
Set wsCopy = ThisWorkbook.Worksheets("Form Single")
Set wsDest = wbDest.Sheets("Sheet1")

'2. Find first blank row in the destination range based on data in column A
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row

'3. Copy & Paste Data
wsCopy.Range("B22:AF25").Copy
wsDest.Range("B" & lDestLastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
wsCopy.Range("B26:AF30").Copy
wsDest.Range("G" & lDestLastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

Application.CutCopyMode = False
wbDest.Close True

Application.ScreenUpdating = True