Excel VBA -在数组中复制单元格并粘贴到下一个空单元格
提问于 2018-09-16 17:54:19
新的VBA，并试图编写一个宏，如果Y列包含某些文本(CHK)，该宏将复制条目的引用号(A列)。我已经能够设置一个数组，它将检查单元格是否包含值CHK，如果包含引用号，则复制引用号(然后对每个单元进行重复)。
我正在挣扎的是将每个单元格的值粘贴到另一个工作簿A行中的下一个空单元格中。我已经成功地将值复制到下一个空单元格中，但我不确定如何将一个单元格向下移动，以便在下一个数组中运行。而此时，每当数组运行时，单元格中的值都会被重写。
我的当前代码如下所示：
Sub Copy_detailed_WithNum_V2()
Application.ScreenUpdating = True
Dim ws1 As Worksheet, ws2 As Worksheet
Dim SrchRng As Range, cel As Range
Set ws1 = Sheets("Detailed Register-All")
Set ws2 = Sheets("VIPP Register")
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
'Activate Detailed Reigster sheet
ws1.Activate
Set SrchRng = Range("Y:Y")
For Each cel In SrchRng
'Check if the cell contains CHK text
If InStr(1, cel.Text, "CHK") Then
'Copy rerference number if entry has CHK value
cel.Offset(0, -24).Copy
'Activate VIPP Register sheet
ws2.Activate
'Paste in the next empty cell in Coulmn A
Cells(lastRow + 1, 1).PasteSpecial xlPasteValues
End If
'Check next cell
Next cel
End Sub
回答 1
Stack Overflow用户
回答已采纳
发布于 2018-09-16 18:01:48
此问题可能是由于您的Range和Cells实例没有对工作表进行限定。另外，请注意，您不需要使用Activate来修改工作表。
与复制值不同，您只需设置两个范围的值相等，这就是我在这里所做的。
Laslty，您的搜索范围目前设置为Y:Y，这是整个列(需要检查的单元格略多于100万)。您需要将其最小化到最小/必要的范围。我把这个设置从Y2开始(假设您有一个标头)，然后向下扫描到列Y中最后使用的单元格。
Sub Copy_detailed_WithNum_V2()
Dim ws1 As Worksheet: Set ws1 = Sheets("Detailed Register-All")
Dim ws2 As Worksheet: Set ws2 = Sheets("VIPP Register")
Dim SrchRng As Range, cel As Range, lastRow As Long
Set SrchRng = ws1.Range("Y2:Y" & ws1.Range("Y" & ws1.Rows.Count).End(xlUp).Row)
Application.ScreenUpdating = False
For Each cel In SrchRng
If InStr(1, cel.Text, "CHK") Then
lastRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1).Row
ws2.Cells(lastRow, 1).Value = cel.Offset(0, -24).Value
End If
Next cel
Application.ScreenUpdating = True
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/52359881
复制
腾讯云开发者
