我正在尝试创建一些代码来查看一系列单元格,并将满足特定参数的单元格复制并粘贴到工作簿中的不同位置。
我想从“sheet5”复制任何带有字母 L 的内容并将特定范围复制到“sheet1”
我的代码的循环部分一定有问题,因为只复制了单元格范围的顶部。我希望粘贴从第 5 行开始并继续向下移动。这是否意味着我正确地将 IRow = IRow + 1 放在粘贴功能下方?
Sub Paste_Value_Test()
Dim c As Range
Dim IRow As Long
Dim rDestination As Excel.Range
Application.ScreenUpdating = False
Sheets("sheet5").Activate
For Each c In Sheets("sheet5").Range("b2", Range("N65536").End(xlUp))
If c.Value = "L" Then
Sheets("sheet5").Cells(c.Row, 2).Copy
Set rDestination = Worksheets("sheet5").Cells(5 + IRow, 12)
rDestination.Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
IRow = IRow + 1
End If
Next c
End Sub
我真的很感激这方面的任何帮助。我对 VBA 比较陌生,将开始认真研究。
最佳答案
这是你正在尝试的任何机会吗?我已经对代码进行了注释,因此您理解它应该没有任何问题。
Sub Paste_Value_Test()
Dim c As Range
Dim IRow As Long, lastrow As Long
Dim rSource As Range
Dim wsI As Worksheet, wsO As Worksheet
On Error GoTo Whoa
'~~> Sheet Where "L" needs to be checked
Set wsI = ThisWorkbook.Sheets("Sheet5")
'~~> Output sheet
Set wsO = ThisWorkbook.Sheets("Sheet1")
Application.ScreenUpdating = False
With wsI
'~~> Find Last Row which has data in Col B to N
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lastrow = .Columns("B:N").Find(What:="*", _
After:=.Range("B1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lastrow = 1
End If
'~~> Set you input range
Set rSource = .Range("B2:N" & lastrow)
'~~> Search for the cell which has "L" and then copy it across to sheet1
For Each c In rSource
If c.Value = "L" Then
.Cells(c.Row, 2).Copy
wsO.Cells(5 + IRow, 12).PasteSpecial Paste:=xlPasteValues
IRow = IRow + 1
End If
Next
End With
LetsContinue:
Application.ScreenUpdating = True
Application.CutCopyMode = False
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
关于vba - 根据单元格值在 VBA 中复制和粘贴循环,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/21441222/