用于将特定的公式行复制到新创build的行的macros
我最近发布了一个问题，不幸的是没有得到任何答案很远。 我已经重新编写了我的macros，以反映我在其他地方发现的类似情况。 问题是我现在被卡在最后。
macros的目的：1.在选定的单元格下方，我需要插入x个新行=input个月-1
-
在第一个插入的行中，我需要一组相对的公式，这些公式可以在当前工作表的实际行2中find（基本上将行2复制并粘贴到创build的第一行）
-
在随后插入的行中，我需要一组相对的公式，这些公式可以在当前工作表的实际行3中find
现在，这个macros做我想要的，除了我不知道如何粘贴第3行的所有后续行。 我假设我需要一些条件陈述？
正如我上一篇文章中提到的，我正在试图教自己的VBA，所以任何帮助将不胜感激！
Sub InsertMonthsAndFillFormulas(Optional vRows As Long = 0) Dim x As Long ActiveCell.EntireRow.Select 'So you do not have to preselect entire row If vRows = 0 Then vRows = Application.InputBox(prompt:= _ "Enter the total number of months in the program", Title:="Add Months", _ Default:=1, Type:=1) 'Default for 1 row, type 1 is number If vRows = False Then Exit Sub End If Dim sht As Worksheet, shts() As String, i As Long ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _ Windows(1).SelectedSheets.Count) i = 0 For Each sht In _ Application.ActiveWorkbook.Windows(1).SelectedSheets Sheets(sht.Name).Select i = i + 1 shts(i) = sht.Name x = Sheets(sht.Name).UsedRange.Rows.Count 'lastcell fixup Selection.Resize(rowsize:=2).Rows(2).EntireRow. _ Resize(rowsize:=vRows - 1).Insert Shift:=xlDown Rows(2).EntireRow.Copy Destination:=Selection.Offset(1).Resize( _ rowsize:=1) Rows(3).EntireRow.Copy Destination:=Selection.Offset(2).Resize( _ rowsize:=1) On Error Resume Next Next sht Worksheets(shts).Select End Sub 好的，根据您的意见，下面的代码应该满足您的需求。 但首先，有几点需要注意。
- 我已经添加了一些评论来帮助您了解代码中发生了什么。
- 根据您对
vRows的评论，如果用户保持默认input框值（“1”），则代码现在将终止。 逻辑是，如果值只有一个，那么不需要添加任何行。 请注意，我从Inputbox值中减去1。 - 该代码假定您有第一行标题或至less填充单元格。 我使用第一行来查找最后使用的列。
- 如果执行此代码时有可能激活错误的工作表，请取消注释我的代码的第16行。 （很明显，您需要更改代码以反映您的工作表名称。
- 最后，这段代码假定数据集的左上angular是
A1。
testing样本数据集
Sub InsertMonthsAndFillFormulas(Optional vRows As Long = 0) Dim lastCol As Long Dim r As Range 'Ask user for number of months. 'If the user keeps the default value (1), exit sub. If vRows = 0 Then vRows = Application.InputBox(prompt:= _ "Enter the total number of months in the program", Title:="Add Months", _ Default:=1, Type:=1) - 1 If vRows = 0 Then Exit Sub End If 'Uncomment this line if you are concerned with which sheet needs to be active. 'ThisWorkbook.Sheets("YourSheet").Select With ActiveSheet 'Set the range to work with as the cell below the active cell. Set r = ActiveCell.Offset(1) 'Find the last used column. (Assumes row one contains headers) 'Commented this out to hard-code the last column. 'lastCol = .Rows("1:1").Find("*", searchdirection:=xlPrevious).Column 'Insert the new rows. r.EntireRow.Resize(vRows).Insert Shift:=xlDown 'r needs to be reset since the new rows pushed it down. 'This time we set r to be the first blank row that will be filled with formulas. Set r = .Range(.Cells(ActiveCell.Offset(1).Row, 1), _ .Cells(ActiveCell.Offset(1).Row, "H")) '<~~ Replaced lastCol with "H" '**Add formulas to the new rows.** 'Adds row two formulas to the first blank row. .Range(.Cells(2, 1), .Cells(2, "H")).Copy r 'Adds row three formulas to the rest of the blank rows. .Range(.Cells(3, 1), .Cells(3, "H")).Copy r.Offset(1).Resize(vRows - 1) End With End Sub
编辑
variableslastCol定义了最右边的列来复制公式。 这个variables是使用第1行的列标题设置的。我更喜欢使用像这样的variables来使代码更健壮（也就是说，您可以在不中断macros的情况下将列添加到数据集中），但是为了达到这个目的，使用列（或至less包含值的单元格）。
如果你不关心增加更多的列，你可以把最后一列硬编码到代码中（参见我的修订版）。