VBA复制和粘贴数据
我是新来的VBA,我试图以下 例如创建一个VBA函数:VBA复制和粘贴数据
输入表,首先我想在列B和C复制和粘贴值对于组1进入工具选项卡,然后我想从工具选项卡抓取单元格E2的值,并将其粘贴到输出选项卡中的单元格B2中,然后对组2,3,4重复相同的步骤。直到空行。
有人能帮助我吗?非常感谢!
Sub test()
Dim i As Integer
Dim j As Integer
lr = Worksheets("input").Range("A" & Rows.Count).End(xlUp).Row
lrj = Worksheets("output").Range("A" & Rows.Count).End(xlUp).Row
For j = 2 To lrj
Sheets("input").Select
For i = 1 To lr
If Sheets("input").Cells(i, 1) = Sheets("output").Range("A2").Offset(j - 2, 0) Then
Range(Cells(i, 2), Cells(i, 3)).Select
Selection.Copy
Sheets("tool").Select
Range("A2").Offset(i - 2, 0).Select
ActiveSheet.Paste
Sheets("input").Select
End If
Next i
Sheets("tool").Select
Range("E2").Select
Selection.Copy
Sheets("output").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next j
End Sub
您不需要tp通过中间tool
选项卡。您可以在output
标签B2
写这个公式然后复制/粘贴沿着列B:
=SUMPRODUCT((input!$B:$B+input!$C:$C)*(input!$A:$A=A2))
编辑
如果你坚持使用tool
片,试试这个,假设你有一个有效的公式在tool!E2
:
Sub useTheToolSheet()
Dim grp As Range, src As Range
Set grp = Worksheets("input").Range("A2")
Do While IsNumeric(grp.Value2)
Set src = grp.Offset(, 1).Resize(, 2)
Do While grp.Value2 = grp.Offset(1).Value2
Set grp = grp.Offset(1)
Set src = src.Resize(src.Rows.Count + 1)
Loop
Worksheets("tool").UsedRange.Offset(1).Resize(, 2).ClearContents
Worksheets("tool").Range("A2").Resize(src.Rows.Count, src.Columns.Count).Value = src.Value2
Worksheets("output").Range("B2").Value = Worksheets("tool").Range("E2").Value2
Set grp = grp.Offset(1)
Loop
End Sub
@tiffsmash问题是,如果你想要一些VBA,你需要自己开始努力。尝试从一些宏观录制开始,尽可能地调整代码并将其发布在问题中,然后我们会帮助您完成它。 –
我试过了,但没有正常工作:( – tiffsmash
你真的需要一个工具选项卡吗? 您可以在输出选项卡中简单使用以下公式: =Sumif(input!A:A,A3,input!B:C)
并向下拖动此公式。
你的代码不断给我一个错误按摩,我不知道它有什么问题。 – tiffsmash