Есть ли способ экспортировать одни и те же ячейки из нескольких книг Excel в один лист Excel? - PullRequest
0 голосов
/ 12 июля 2019

Я делаю форму запроса на возврат листа Excel.Мне удалось сделать кнопку, которая печатает 2 копии и сохраняет ее как заполненную форму.Но я хотел бы иметь возможность загружать сводку формы (4 конкретные ячейки - дата, имя, имя элемента, код идентификатора элемента) в электронные таблицы Google.Чтобы сделать это проще, я хотел бы сделать основную рабочую книгу, из которой я бы скопировал и вставил сводку всех форм, заполненных в этот день.

Я пытался изучить интеграцию листов Excel-Google черезAPI, но я не программист, и тема захлестнула меня.

Я также нашел эту тему: Импорт данных из определенных таблиц Excel из нескольких рабочих книг в папке

Но код там копирует целые столбцы, в то время как мне нужны только 4 конкретные ячейки.

 Private Sub CommandButton1_Click()

    response = MsgBox("Jesteś pewien?", vbYesNo)

    If response = vbNo Then
        MsgBox ("Macro Ending")
        Exit Sub
    End If

    Dim path As String
    Dim filename1 As String

    path = "D:\filled forms\"

    filename1 = Format(Now, "dd-mm-yyyy") & " " & Range("C9") & " " & Range("G6")
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=path & filename1 & ".xlsm",
    FileFormat:=xlOpenXMLWorkbookMacroEnabled
    ActiveSheet.PrintOut Copies:=2, Collate:=False

    With ThisWorkbook.Worksheets("sheet1")
        .Range("E29").Copy
        With Workbooks("mastersheet.xlsx").Worksheets("Arkusz1")
            Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End With
    End With

End Sub

К сожалению, этот код не копирует содержимое ячейки, и я в итоге получаю пустую книгу.

Редактировать: мне удалось найти решение, вот как это выглядит

Private Sub CommandButton1_Click()

response = MsgBox("Jesteś pewien?", vbYesNo)

If response = vbNo Then
    MsgBox ("Akcja anulowana.")
    Exit Sub
End If

Dim path As String
Dim filename1 As String

path = "D:\"

filename1 = Format(Now, "dd-mm-yyyy") & " " & Range("C9") & " " & Range("G6")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=path & filename1 & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveSheet.PrintOut Copies:=2, Collate:=False
Worksheets("Sheet1").Range("C34:F34").Copy
Workbooks("analiza.xlsx").Worksheets("arkusz1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues


End Sub

1 Ответ

0 голосов
/ 12 июля 2019

Вы можете скопировать только те ячейки, которые вам нравятся:

Dim fromData As Range
Set fromData = ThisWorkbook.Worksheets("sheet1").Range("E29:E31")

Dim toData As Range
Dim lastRow As Long
With Workbooks("mastersheet.xlsx").Worksheets("Arkusz1")
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set toData = .Range(.Cells(lastRow + 1, 1), .Cells(lastRow + 3), 1))
End With
toData.Value = fromData.Value
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...