有没有办法将多个 Excel 工作簿中的相同特定单元格导出到一个 Excel 工作表中？

Question

我正在制作 Excel 表格退款申请表。我设法制作了一个按钮，可以打印 2 个副本并将其保存为填写好的表格。但我希望能够将表单摘要（4 个特定单元格 - 日期、名称、项目名称、项目 ID 代码）上传到 Google 电子表格。为方便起见，我想制作一个主工作簿，从中复制并粘贴当天填写的所有表格的摘要。

我尝试过通过 API 研究 excel-google 表格集成，但我不是程序员，这个话题让我不知所措。

我也发现了这个话题：Importing Data from specific excel sheets from multiple workbooks in a folder

但是那里的代码会复制整个列，而我只需要 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

Answer 1

你可以只复制你喜欢的单元格：

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