Макрос для копирования / вставки строк в новый лист в зависимости от критериев

Question

У меня есть список имен и данных со следующими заголовками:

Year    Forename    Surname DOB Gender  UPN

Переменная данных заключается в том, что в столбце 1 (A) 7 лет (год 1 - год 7)

Я хотел бы запустить макрос, который

1. Копирует строки в свой рабочий лист в зависимости от того, в каком году ребенок находится в столбце А.
2. Если возможно, следует создать новый рабочий лист, например, год 1, год 2, год 3 и т.д. С соответствующими данными во всех 6 столбцах данных.

Я пытался в течение нескольких дней смешивать и совмещать несколько макросов безрезультатно, и я не хочу использовать ifs/lookups, как это будет для администратора, и хочу, чтобы это было нажатием одной кнопки.

Спасибо заранее.

Answer 1

Это должно сделать работу:

Sub yearAssign()
    Application.ScreenUpdating = False
    On Error GoTo SheetError
    sheetname = "initial"
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim wks1 As Worksheet
    Set wkb = ThisWorkbook
    Set wks = Sheets(sheetname)
    totalsheets = wkb.Worksheets.Count
    For i = 1 To totalsheets
        Set wks1 = wkb.Worksheets(i)
        thename = wks1.Name
        If thename <> sheetname Then
            wks1.Rows.Clear
        End If
    Next i
    totalrows = wks.Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To totalrows
        theyear = wks.Cells(i, 1)
        Set wks1 = Sheets(theyear)
            lastrow = wks1.Cells(Rows.Count, "A").End(xlUp).Row + 1
            If lastrow = 2 Then
                wks.Rows(1).Copy Destination:=Sheets(theyear).Range("A1")
            End If
            wks.Rows(i).Copy Destination:=Sheets(theyear).Range("A" & lastrow)
    Next i
    Application.ScreenUpdating = True
    finish = MsgBox("Finished", vbInformation)

SheetError:
    If Err.Number = 9 Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = theyear
        Resume
    End If
End Sub

Перейдите в VBA /Macro, в ThisWorkbook вставьте новый модуль и вставьте код в правой части окна.

Предполагается, что данные находятся в листе с именем initial ", замените строку имя sheetname="initial" на имя, которое вы используете.