首页 文章

VBA复制并粘贴多个单元格，而不会覆盖现有信息

提问于
浏览 次
0

我有多本excel书籍，我需要从中提取数据并将其放在统一视图中 . 我一直在尝试从一个工作簿中复制和粘贴不同的单元格并将它们粘贴到另一个工作簿中 . 我设法用一个单元格做到这一点，但我不太确定如何为多个单元格（不是范围）这样做？

可以说我有5个文件 . 我循环遍历它们，我希望将Cell F18复制到Cell A1和Cell 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 = True End Sub

excel vba

1 回答

  • 0

    你的代码看起来不完整它只复制一个单元格，我看不到它覆盖以前的值 . 我也收到了警告，因为代码是从一个单元格复制而是粘贴到两个单元格中 .

    我会采取不同的方法 . 我不是复制/粘贴，而是设置目标单元格的值以匹配源，然后每次将目标向下移动一行，而不是检查最后填充的行：

    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
    回复于

相关问题