首页 文章

复制特定单元格并粘贴到另一张纸上[复制]

提问于
浏览 次
0

这个问题在这里已有答案：

前段时间我在成员simoco的帮助下收到了我的问题Copy Range and Paste Values in another Sheet's specific Range，复制粘贴脚本效果很好，但现在我需要的东西有点不同了 .

我需要从一张纸上复制特定的单元格并将其粘贴到另一张纸上的特定范围内，以便构建“DB” .

这意味着每当我运行脚本时，它都需要将值复制到下一个空行 .

我试图通过将数组从Range更改为Cell数来修改另一个问题中提到的代码，但它不起作用 .

我试过这个 .

Sub Get_Data()
Dim lastrowDB As Long, lastrow As Long
Dim arr1, arr2, i As Integer

With Sheets("DB")
    lastrowDB = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

arr1 = Array("A3", "A4", "A6", "B14")
arr2 = Array("A", "B", "D", "E")

For i = LBound(arr1) To UBound(arr1)
    With Sheets("Sheet1")
         lastrow = Application.Max(3, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row)
         .Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy
         Sheets("DB").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues
    End With
Next
Application.CutCopyMode = False
End Sub

调试指向

lastrow = Application.Max(3, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row)

我不知道如何修改它以使其按预期工作 .

提前感谢你的帮助 .

excel vba excel-vba

1 回答

  • 1

    下面的脚本遍历包含源单元格地址的 SourceArr 数组，并将值粘贴到 DestArr 数组中指定的目标列：

    Option Explicit
Sub MoveDataToDB()

Dim DB As Worksheet, SH As Worksheet
Dim TargetRow As Long, Index As Long
Dim SourceArr As Variant, DestArr As Variant
Dim Source As Range, Dest As Range

'set references up-front
Set SH = ThisWorkbook.Worksheets("Sheet1")
Set DB = ThisWorkbook.Worksheets("DB")
With DB
    TargetRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With
SourceArr = Array("A3", "A4", "A6", "B14")
DestArr = Array("A", "B", "D", "E")

'loop through the source array, copying cell values to DB sheet
For Index = LBound(SourceArr) To UBound(SourceArr)
    Set Source = SH.Range(SourceArr(Index))
    Set Dest = DB.Range(DestArr(Index) & TargetRow)
    Source.Copy
    Dest.PasteSpecial (xlPasteValues)
Next Index

End Sub

    实现下线的一个可能的改进是 Source 检查 Source 范围，以确保已填充正确的单元格 .

    回复于

相关问题