我对VBA很新。我目前正试图通过使用宏来找到一种更快速的方法来复制和粘贴信息。我不知道如何编码。
我想在For Each循环中使用两列。 我想循环遍历这两列的每一行并使用If函数。如果第一行在列B中具有值(列B单元格<>“或”列B单元格<> 0“),则选择该行(即,范围(”A1:B1“))。
在循环之后,我将复制所选的任何内容并将其粘贴到特定的行。 但是,我想继续添加该选择,因为它遍历每一行,并且只有当它满足If条件时,所以我能够在结束时将其全部复制一次。我如何组合这个?
A B
1 Abc 1
2 Def 2
3 Geh 3
答案 0 :(得分:0)
这是扩展当前选择的方法:
error.log
我确定您可以自己管理其余代码,这非常简单。您已经提到了所需的一切:Sub macro1()
Set selectedCells = Cells(1, 2)
Set selectedCells = Application.Union(selectedCells, Cells(2, 3))
selectedCells.Select
End Sub
和For Each cell In Range("B1:B5")
声明
答案 1 :(得分:0)
请尝试以下代码
Sub test()
Application.ScreenUpdating = False
Dim rng As Range, one As Variant
Dim i As Integer
'Change the sheet and range name as yours
'Finding lastrow of destination column
i = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1
' getting input from user
Set rng = Application.InputBox("Please select a range of cells!", "Please select a range", Selection.Address, , , , , 8)
For Each one In rng
If one.Value <> "" Or one.Value <> 0 Then
Range(one.Offset(0, -1), one).Copy
'Change the sheet and range name as yours
Sheets("Sheet2").Activate
Range("A" & i).Select
ActiveSheet.Paste
i = i + 1
End If
Next one
Application.ScreenUpdating = True
End Sub
上述宏将提示您输入范围以进行验证并复制到A列中的sheet2。
以下代码将验证并复制粘贴当前所选范围到sheet2列A
Sub test()
Application.ScreenUpdating = False
Dim rng As Range, one As Variant
Dim i As Integer
'Chnage the sheet and range name as yours
'Finding lastrow of destination column
i = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1
' getting input from user
Set rng = Selection
For Each one In rng
If one.Value <> "" Or one.Value <> 0 Then
Range(one.Offset(0, -1), one).Copy
'Chnage the sheet and range name as yours
Sheets("Sheet2").Activate
Range("A" & i).Select
ActiveSheet.Paste
i = i + 1
End If
Next one
Application.ScreenUpdating = True
End Sub
答案 2 :(得分:0)
我认为你可能会以错误的方式解决这个问题。您是否已经知道最终要将所有数据复制到哪里?这听起来像是,因为你指的是将它复制到一个特定的行&#34;。如果是这样,您最好使用宏来动态复制A列中的数据。
所以,例如:
Sub CopyData()
Const SOURCE_COLUMN1 As Long = 1 ' A
Const SOURCE_COLUMN2 As Long = 2 ' B
Const TARGET_COLUMN1 As Long = 5 ' E
Const TARGET_COLUMN2 As Long = 6 ' F
Dim lngSourceRow As Long
Dim lngTargetRow As Long
With ThisWorkbook.Sheets("Sheet1")
lngSourceRow = 1
lngTargetRow = 0 ' Change this to the row above the one you want to copy to;
Do While .Cells(lngSourceRow, SOURCE_COLUMN1) <> ""
If .Cells(lngSourceRow, SOURCE_COLUMN2) <> "" Then
lngTargetRow = lngTargetRow + 1
.Cells(lngTargetRow, TARGET_COLUMN1) = .Cells(lngSourceRow, SOURCE_COLUMN1)
.Cells(lngTargetRow, TARGET_COLUMN2) = .Cells(lngSourceRow, SOURCE_COLUMN2)
End If
lngSourceRow = lngSourceRow + 1
Loop
End With
End Sub