我需要将公式和格式从上面的行或下面的行复制到新插入的行中

Question

我有一个工作簿，其中包含我理发店分会的每个成员的单独工作表，用于跟踪每个成员的广告销售情况。工作表 1 汇总了每个成员工作表中的数据。当我们有一个新成员时，我手动复制一个主成员工作表，按字母顺序将其插入成员工作表列表并用成员的名字重命名。我有一个宏，可以将此新成员/工作表名称插入到工作表 1 中的列范围中，该范围包含成员/工作表列表，然后按字母顺序对该列表进行排序。这很好用。现在，这就是我遇到问题的地方，我想在同一个宏中插入代码（如果这是正确的方法）以复制公式和格式（如果新行在中间，则从上面的行列表中，或者如果新工作表恰好插入到成员列表的顶部，则从下面的行），第 2 列到行尾，向下进入新行。我可以手动完成所有这些，但我正在努力学习编写宏。我可以根据手动执行任务来记录宏，但这不会给我代码以允许在包含公式的范围内插入新列，对吗？下面是我不完整的代码（我对它的复制方式不满意）； If 语句是我试图检查新行是在成员列表的顶部还是在中间并完成复制的地方。请不要嘲笑我的新手努力；-) 感谢您的帮助。

 Public Sub AddWkshtNametoGrandTotals()

    Dim LastRow As Long
    Dim WsName As String
    Dim Ws_GT As Worksheet
    Dim MemberList As Range
    Dim NewNameRef As Range

    Set Ws_GT = Sheets("Sheet1")
    Ws_GT.Range("A:A").Name = "MemberList"
    'Find first empty cell at bottom of worksheet Grand Totals
    LastRow = Ws_GT.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
    WsName = ActiveSheet.Name 'Keep track of current worksheet
    Ws_GT.Cells(LastRow, 1) = WsName  'Put current worksheet name
    'into first empty cell at bottom of worksheet Grand Totals
    Range("MemberList").Sort Key1:=Range("MemberList") 'Sort member name list with new name added
    Set NewNameRef = Ws_GT.Range("MemberList").Find(WsName).Cells
    'Check for position of new row
    If NewNameRef.Row = 1 Then
        Range("NewNameRef.Offset(1, 1),Cells(Columns.Count,1).End.xlRight.Column").Copy _
        Destination:=Range("NewNameRef.Offset(0, 1)")
        'NewNameRef.Offset(-1, 1).Copy.EntireRow
        'NewNameRef.Offset(0, 1).EntireRow.PasteSpecial Paste:=xlPasteFormats
        'NewNameRef.Offset(0, 1).EntireRow.PasteSpecial Paste:=xlPasteFormulas
    Else
        Rows(Selection.Row - 1).Copy
        Rows(Selection.Row).Insert Shift:=xlDown

    End If

结束子

Answer 1

在排序之前复制格式和公式可能更容易：

编辑 - 在看到您的工作簿之后

Public Sub AddWkshtNametoSheet1()

    Dim LastRow As Long
    Dim WsName As String
    Dim WsGT As Worksheet
    Dim MemberList As Range

    Set WsGT = ThisWorkbook.Sheets("Grand Totals")

    WsName = ActiveSheet.Name 'Keep track of current worksheet

    'Find first empty cell at bottom of Column 1, Sheet1

    With WsGT
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
        WsGT.Range("A8:A" & LastRow).Name = "MemberList"
        .Rows(LastRow - 1).Copy
        .Cells(LastRow, 1).PasteSpecial Paste:=xlPasteFormats
        .Cells(LastRow, 1).PasteSpecial Paste:=xlPasteFormulas
        .Cells(LastRow, 1) = WsName
    End With

    Range("MemberList").Sort Key1:=Range("MemberList")

End Sub

Answer 2

如果您在 Excel >2003 中使用表格（功能区/插入/表格），如果您在表格中最后一行的正下方的行中添加内容，则会自动在表格中创建一个新表格行。公式也会自动应用。

Sub M_snb()
  With ListObjects(1).Range
    .Cells(.Rows.Count, 1).Offset(1).Value = "new"
    .Columns(1).Sort .Cells(1), , , , , , , xlYes
  End With
End Sub