使用userform将用户（和行）添加到多个工作表

Question

我希望自己能够解决这个问题，之前我提供了解决我之前删除行的问题的解决方案，但我意识到它并不像我想象的那么简单。

我在工作簿中有许多工作表，用于收集学生的各种数据。

每个工作表都以瞳孔名称和有关它们的详细信息开头 - 这些是从“主数据”工作表中复制的 - 各种数据都输入到每个工作表的后续列中。

我有一个用户表单来添加和删除所有工作表中的学生。

我有一些我从Roy Cox修改过的代码，它在主数据列表的底部添加了一个学生，然后对数据进行排序，以便学生按照正确的字母顺序排列在正确的类中。

EDITED 11/09 - 16:34 - 为清晰起见，复制了整个代码。

Private Sub cmbAdd_Click()
Dim Sh As Worksheet
Dim l As Long

Application.ScreenUpdating = False

' 1) ADD NEW ROW TO EACH WORKSHEET, COPYING FORMAT AND FORMULAE

For Each Sh In ThisWorkbook.Worksheets
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    Rows(Selection.Row).Insert Shift:=xlDown

    With Cells(Rows.Count, "A").End(xlUp)
        .EntireRow.Copy
            With .Offset(1, 0).EntireRow
                .PasteSpecial xlPasteFormats
                .PasteSpecial xlPasteFormulas
            On Error Resume Next
        .SpecialCells(xlCellTypeConstants).ClearContents
    On Error GoTo 0
            End With
    End With
Next Sh

' 2) COPY NEW CHILD FROM USERFORM TO MASTER DATA WORKSHEET

Dim LR As Long
    LR = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row

    Set c = Range("A" & LR + 1)

    With Me
    c.Value = .TextBox14.Value
    c.Offset(0, 1).Value = .TextBox1.Value
    c.Offset(0, 2).Value = .TextBox2.Value
    c.Offset(0, 3).Value = .TextBox3.Value
    c.Offset(0, 4).Value = .TextBox4.Value
    c.Offset(0, 5).Value = .TextBox24.Value
    c.Offset(0, 7).Value = .TextBox25.Value
    c.Offset(0, 8).Value = .TextBox26.Value
    c.Offset(0, 9).Value = .TextBox5.Value
    c.Offset(0, 11).Value = .TextBox27.Value
    c.Offset(0, 12).Value = .TextBox28.Value
    c.Offset(0, 13).Value = .TextBox29.Value
    c.Offset(0, 14).Value = .TextBox30.Value
    c.Offset(0, 15).Value = .TextBox31.Value
    c.Offset(0, 16).Value = .TextBox32.Value
    c.Offset(0, 17).Value = .TextBox33.Value
    Call ClearControls
End With

' 3) FILL EMPTY CHARACTERISTICS CELLS ON MASTER DATA WORKSHEET

Dim rCell   As Range
Dim rRng    As Range

For Each rRng In ActiveSheet.[A3].Resize(ActiveSheet.UsedRange.Rows.Count - 2)
    If IsEmpty(rRng) Then GoTo NextRow
    For Each rCell In rRng.Offset(0, 7).Resize(1, 14)
        If IsEmpty(rCell) Then rCell.Value = "N"
    Next rCell
NextRow:
Next rRng

' 4) SORT DATA TO INCLUDE NEW CHILD ON EACH WORKSHEET

 Call ResortData

Application.ScreenUpdating = True

End Sub

ResortData子目录也在下面添加：

Sub ResortData()

Dim Sh As Worksheet
Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

For Each Sh In ThisWorkbook.Worksheets

Range("A4:BE" & LastRow).Sort Key1:=Range("C4:C" & LastRow), Order1:=xlAscending, Header:=xlNo, _
Key2:=Range("B4:B" & LastRow), Order1:=xlAscending, Header:=xlNo ' CHANGE 'BE' TO LAST COLUMN OF SPREADSHEET

Next

Application.ScreenUpdating = True

End Sub

目前，“主数据”表更新了新学生和另外3行（我的试用工作簿中有3个其他工作表，所以我认为这就是原因）。

在完成主工作表上的步骤2和3之后，如何确保代码在每个工作表中添加一个新行，然后在每个工作表上执行步骤4？

（我需要分别在每个工作表上完成第4步，因为收集的数据和每个工作表上的列标题从第V列开始不同）

感谢您提供的任何建议。

Answer 1

在完成主工作表上的步骤2和3之后，如何确保代码在每个工作表中添加新行，然后在每个工作表上执行步骤4？

好吧，简单地将每一步放入单独的循环中。

For Each Sh In ThisWorkbook.Worksheets

    'code for e.g. step 1'

Next Sh

并把它按顺序排列。

另外，考虑一下，我计划在工作簿中添加一些额外的工作表，这些工作表将采用不同的格式，并将分析数据并呈现要打印的表格和模板中数据的各个方面。是否可以编写代码以使这些表不受影响？

您可以使用If语句排除一些工作表

For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "Sheet2" And Sh.Name <> "Sheet3" Then
        'code'
    End If
Next Sh

或者反过来说：

For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name = "Sheet2" Or Sh.Name = "Sheet3" Then
        'code'
    End If
Next Sh

Answer 2

所以看看你的For循环，你正在做的是：你拾取工作簿中的每个工作表，然后引用活动工作表上的单元格而不是你想要引用的工作表。这是因为当您引用单元格/范围时，您没有明确说明要添加该行的工作表..尝试下面的代码（我还没有测试过代码）：

Dim Sh As Worksheet

For Each Sh In ThisWorkbook.Worksheets
    ' Use the current worksheet
    With Sh

        ' Notice the dots(.) infront of Cells and Rows. This is now referencing the cells and rows in 'Sh' sheet
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
        .Rows(Selection.Row).Insert Shift:=xlDown

        With .Cells(.Rows.Count, "A").End(xlUp)
            .EntireRow.Copy
            With .Offset(1, 0).EntireRow
                .PasteSpecial xlPasteFormats
                .PasteSpecial xlPasteFormulas
                On Error Resume Next
                .SpecialCells(xlCellTypeConstants).ClearContents
                On Error GoTo 0
            End With
        End With
    End With
Next Sh