重复VBA sub复制和“粘贴值”多行

我对VBA很新。

我的财务电子表格已经变得非常复杂，而且手工复制和粘贴任务可能会在初期设置得更好。

我的任务相当简单（我认为）：我想要复制8个单元格并将其粘贴到（在上个月的硬编码值中设置dynamic预算），然后将此过程重复到6个其他目标相同的单元格模式相同的列。

例如：

（1）复制 – >粘贴值H4：H5，H8，H10和H13：H16

（2）在H23：H24（H4：H5 + 20行），H27（H8 + 20行），H39（H10 + 20行），H32：H35（H13：H：16 + 20行）

（3）然后在列上多次重复同样的复制和粘贴模式：

H 4 **Paste Value** 5 **Paste Value** 6 Leave alone 7 Leave alone 8 **Paste Value** 9 Leave alone 10 **Paste Value** 11 Leave alone 12 Leave alone 13 **Paste Value** 14 **Paste Value** 15 **Paste Value** 16 **Paste Value** Skip H:17:H22 H 23 **Paste Value** 24 **Paste Value** 25 Leave alone 26 Leave alone 27 **Paste Value** 28 Leave alone 29 **Paste Value** 30 Leave alone 31 Leave alone 32 **Paste Value** 33 **Paste Value** 34 **Paste Value** 35 **Paste Value** 

这是我为第一组录制的macros：

 Sub RFC_Paste_Month_Values() ' ' RFC_Paste_Month_Values Macro Range("H4:H5").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("H8").Select Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("H10").Select Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("H13:H16").Select Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ' Copy and "Paste Special- Values" of set budgets ' End Sub 

任何帮助将非常感激。 谢谢！

摊晒

Answer 1

这里是你的代码的一个简短的版本，有很多的macroslogging器生成的东西取出。 这可以进一步改善，但你需要进一步解释你在做什么：

更新的答案

 Sub RFC_Paste_Month_Values() ' ' RFC_Paste_Month_Values Macro ' Dim i As Integer With ActiveSheet For i = 0 To .UsedRange.Rows.Count Step 19 ' .Range(.Cells(4 + i, 8), .Cells(5 + i, 8)) = .Range(.Cells(4 + i, 8), .Cells(5 + i, 8)).Value .Cells(8 + i, 8) = .Cells(8 + i, 8).Value .Cells(10 + i, 8) = .Cells(10 + i, 8).Value .Range(.Cells(13 + i, 8), .Cells(16 + i, 8)) = .Range(.Cells(13 + i, 8), .Cells(16 + i, 8)).Value Next i End With End Sub 

再次…我没有机会去testing它，但我认为它应该适合你。