VBA復制並粘貼多個單元格，而不會覆蓋現有信息

Question

我有多本excel書，我需要從中提取數據並將其放在合並的視圖中。 我一直在嘗試從一個工作簿復制並粘貼不同的單元格，然后將它們粘貼到另一個工作簿。 我設法用一個單元格做到了這一點，但我不太確定如何對多個單元格（但不是范圍）做到這一點？

可以說我有5個文件。 我遍歷它們，並希望將單元格F18復制到單元格A1並將單元格F14復制到B1 ...然后轉到下一個文件並執行相同的操作，但將信息附加在下一個空白行上。

這是我正在使用的代碼

Sub AllFiles()
Dim folderPath As String
Dim filename As String
Dim wb As Workbook

folderPath = "C:\Users\enchevay\Desktop\automation\WeeklyReports\"

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

filename = Dir(folderPath & "*.xlsx")
Do While filename <> ""
  Application.ScreenUpdating = False
    Set wb = Workbooks.Open(folderPath & filename)


   'copy name (cell F18 and paste it in cell A2)
    Range("F18").Copy

    'copy client (cell F14 and paste it to B2)

         Application.DisplayAlerts = False
        ActiveWorkbook.Close

        emptyRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(emptyRow, 1), Cells(emptyRow, 2))

    filename = Dir
Loop

Application.ScreenUpdating =真實結束子

Answer 1

您的代碼看起來不完整； 它僅復制一個單元格，而我看不到它在哪里覆蓋先前的值。 由於代碼是從一個單元復制但粘貼到兩個單元中，因此我也得到了警告。

我會采取另一種方法。 除了復制/粘貼外，我只需將目標單元格的值設置為與源匹配，然后每次將目標向下移動一行，而不是檢查最后填充的行：

Sub AllFiles()
    Dim folderPath As String
    Dim filename As String
    Dim wb As Workbook

    folderPath = "C:\Users\enchevay\Desktop\automation\WeeklyReports\"

    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

    filename = Dir(folderPath & "*.xlsx")

    Dim targetCell As Range: Set targetCell = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

    Do While filename <> ""
        Set wb = Workbooks.Open(folderPath & filename)

        targetCell.Value = Range("f18").Value
        targetCell.Offset(0, 1) = Range("f14").Value
        Set targetCell = targetCell.Offset(1, 0)

        ActiveWorkbook.Close
        filename = Dir
    Loop
End Sub