如何将新行插入到范围中并复制公式
我有一个如下涵盖A2：D3的命名范围
ITEM PRICE QTY SUBTOTAL 1 10 3 30 1 5 2 10 TOTAL: 40 我要插入一个新的行使用VBA到复制公式不值的范围。
任何提示/链接非常感谢。
这应该做到这一点：
Private Sub newRow(Optional line As Integer = -1) Dim target As Range Dim cell As Range Dim rowNr As Integer Set target = Range("A2:D3") If line <> -1 Then rowNr = line Else rowNr = target.Rows.Count End If target.Rows(rowNr + 1).Insert target.Rows(rowNr).Copy target.Rows(rowNr + 1) For Each cell In target.Rows(rowNr + 1).Cells If Left(cell.Formula, 1) <> "=" Then cell.Clear Next cell End Sub
如果你开始录制一个macros，并且真正完成这个任务，它将为你生成代码。 一旦完成，停止录制macros，你会得到所需的代码，然后你可以修改。
这应该可以帮助你： http : //www.mvps.org/dmcritchie/excel/insrtrow.htm
我需要推出一种解决scheme，其工作方式与数据连接查询扩展结果范围的方式一样，可选地将自动填充公式向右移动。 也许两年迟到的赏金，但我很乐意分享！
Public Sub RangeExpand(rangeToExpand As Range, expandAfterLine As Integer, Optional linesToInsert As Integer = 1, Optional stuffOnTheRight As Boolean = False) Debug.Assert rangeToExpand.Rows.Count > 1 Debug.Assert expandAfterLine < rangeToExpand.Rows.Count Debug.Assert expandAfterLine > 0 If linesToInsert = 0 Then Exit Sub Debug.Assert linesToInsert > 0 Do rangeToExpand.EntireRow(expandAfterLine + 1).Insert linesToInsert = linesToInsert - 1 Loop Until linesToInsert <= 0 If stuffOnTheRight Then rangeToExpand.Item(expandAfterLine, rangeToExpand.Columns.Count + 1).Select Range(Selection, Selection.End(xlToRight)).Select Range(rangeToExpand.Item(expandAfterLine, 1), Selection).Select Else Range(rangeToExpand.Item(expandAfterLine, 1), rangeToExpand.Item(expandAfterLine, rangeToExpand.Columns.Count)).Select End If Selection.AutoFill Destination:=Range(rangeToExpand.Item(expandAfterLine, 1), rangeToExpand.Item(rangeToExpand.Rows.Count, Selection.Columns.Count)) End Sub
此答案解决了以下3个问题与当前接受的答案来自@marg最初发布时间：14年4月13日在9:43。
-
target.Rows(rowNr + 1).Insert：1.1。 没有扩展一行的命名范围（AFAIK通过插入行隐式地这样做的唯一方法（而不是显式修改范围定义），并且在指定的行＃ 之后通过行＃的第一行到第一行）和1.2）仅将target范围中的列向下移动一行。 在许多情况下（也可能是大多数情况下），target范围右侧和/或左侧的列也需要向下移动。 -
target.Rows(rowNr).Copy target.Rows(rowNr + 1)不会复制通常情况下通常不需要的格式。
Private Sub InsertNewRowInRange（_ TargetRange As Range，_ Optional InsertAfterRowNumber As Integer = -1，_ Optional InsertEntireSheetRow As Boolean = True）
' -- InsertAfterRowNumber must be 1 to TargetRange.Rows.Count - 1 for TargetRange to be extended by one Row and for there to be ' -- Formats and Formulas to copy from (eg can't be 0). Default: If -1, defaults to TargetRange.Rows.Count. ' -- Recommend dummy spacer Row at the bottom of TargetRange which, btw, would also be necessary to manually extend a Range ' -- by one Row implicitly via Insert Row (vs. explicilty via changing Range definition). If InsertAfterRowNumber = -1 Then InsertAfterRowNumber = TargetRange.Rows.Count End If If InsertEntireSheetRow Then TargetRange.Cells(InsertAfterRowNumber + 1, 1).Select Selection.EntireRow.Insert Else TargetRange.Rows(InsertAfterRowNumber + 1).Insert End If TargetRange.Rows(InsertAfterRowNumber).Select Selection.Copy TargetRange.Rows(InsertAfterRowNumber + 1).Select Selection.PasteSpecial _ Paste:=xlPasteFormats, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False Selection.PasteSpecial _ Paste:=xlPasteFormulas, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False Application.CutCopyMode = False End Sub