复制特定单元格并粘贴到另一个工作表上

前段时间，我收到了来自成员simoco的帮助，在我的问题复制范围和粘贴值在另一个工作表的特定范围和复制粘贴脚本的作品奇妙，但现在我需要的东西有点不同。

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

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

我试图修改在另一个问题上提到的代码，通过将数组从一个范围更改为单元格编号，但它不起作用。

我试过这个。

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 

debugging指向

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

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

提前感谢你的帮助。

Answer 1

下面的脚本遍历包含源单元格地址的DestArr数组，并按照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范围进行IsEmpty检查，以确保正确的单元格已被填充。