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

I need to copy formulae and formatting from the row above or the row below into a newly inserted row

提问by user2161965

I have a workbook, containing a separate worksheet for each member of my Barbershop Chapter, that keeps track of each member's ad sales. Worksheet 1 summarizes data from each member worksheet. When we get a new member, I manually copy a master member worksheet, insert it alphabetically into the list of member worksheets and rename it with the member's name. I have a macro that inserts this new member/worksheet name into a column range in worksheet 1 that contains a list of members/worksheets and then sorts this list alphabetically. This works well. Now, and this is where I am having problems, I would like to insert code in this same macro (if this is the proper way to do it) to copy formulae and formatting (from the row above if the new row is in the midst of the list, or from the row below if the new worksheet happens to get inserted at the top of the member list), column 2 through the end of the row, down into the new row. I could do all of this manually, but I am trying to learn to write macros. I could record a macro based on doing the task manually, but that wouldn't give me the code to allow for inserting new columns within the range containing the formulae, would it? Below is my incomplete code (I'm not pleased at how it copied); the If statement is where I'm trying to check to see if the new row is at the top of the member list or in the middle and accomplish the copy. Please don't laugh at my novice efforts;-) Thanks for your help.

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

End Sub

结束子

回答by Tim Williams

Might be easier to copy the formats and formulas beforesorting:

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

EDIT- after seeing your workbook

编辑- 看到你的工作簿后

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

回答by snb

If you use a table (Ribbon / Insert / Table) in Excel >2003 a new table row in the table will be created automatically if you add something in the row right below the last one in the table. The formulae will apply automatically as well.

如果您在 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