VBA Excel - проблема с синтаксисом диапазона макросов

Question

Так что я изо всех сил пытался заставить эту электронную таблицу функционировать должным образом. По сути, я предварительно сортирую свои данные по названию техников (столбец H). Затем я хочу скопировать каждое назначенное им оборудование на отдельные рабочие листы со своим именем. Я не могу понять синтаксис диапазона для строки копирования. У меня работает 2 счетчика. Счетчик, чтобы продолжать сравнивать каждую строку, и TechCount, чтобы сместить начальную точку моего диапазона копирования. Я полный новичок, поэтому я уверен, что есть более эффективный способ сделать это.

Пример: Набор данных

    'Create individual Worksheets for Techs with Primary & Secondary Assignments
Dim ws As Worksheet
Dim TechNm As String
Dim wsNM As String
Dim counter As Integer
Dim TechCount As Integer


    ActiveWorkbook.Worksheets("DATA SET").Select
    TechNm = ActiveWorkbook.Sheets("DATA SET").Range("H2").Value
    counter = 0
    TechCount = 0


Do

        If IsEmpty(Range("H2").Value) = True Then
                    Exit Do
        End If

        If TechNm = ActiveWorkbook.Sheets("DATA SET").Range("H2").Offset(counter + 1, 0).Value Then
            counter = counter + 1

        ElseIf TechNm <> ActiveWorkbook.Sheets("DATA SET").Range("H2").Offset(counter + 1, 0).Value Then

                 'Create Worksheet with Tech Name
                wsNM = ActiveWorkbook.Sheets("DATA SET").Range("H2")
                Set ws = ActiveWorkbook.Sheets.Add(after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
                ws.Name = wsNM

                 'Copy Header Row to new worksheet
                ActiveWorkbook.Sheets("DATA SET").Rows(1).EntireRow.Copy ActiveWorkbook.Sheets(wsNM).Range("A1")

                 'Move Tech assignments to new sheet 
                **ActiveWorkbook.Sheets("DATA SET").Range("A" & TechCount & ":A" & counter).EntireRow.Copy ActiveWorkbook.Sheets(wsNM).Range("A2")**
                    Cells.Select
                    With Selection
                        .HorizontalAlignment = xlLeft
                        .VerticalAlignment = xlBottom
                        .WrapText = False
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = False
                        .EntireColumn.AutoFit
                    End With

                    Rows(1).EntireColumn.AutoFilter
                    Range("A2").Select
                    Application.CutCopyMode = False

                'Change Do Loop Parameters
                ActiveWorkbook.Worksheets("DATA SET").Select
                counter = counter + 1
                TechCount = counter
                TechNm = ActiveWorkbook.Sheets("DATA SET").Range("H2").Offset(counter, 0).Value


        End If
Loop


ActiveWorkbook.Worksheets("TECH ASSIGNMENTS").Select

End Sub

Answer 1

Избегайте выбора и использования переменных.

Sub test()
    'Create individual Worksheets for Techs with Primary & Secondary Assignments
Dim Ws As Worksheet, myWs As Worksheet
Dim TechNm As String
Dim wsNM As String
Dim counter As Integer
Dim TechCount As Integer
Dim Wb As Workbook

    'ActiveWorkbook.Worksheets("DATA SET").Select
    Set Wb = ActiveWorkbook
    Set myWs = Wb.Worksheets("DATA SET")
    'TechNm = ActiveWorkbook.Sheets("DATA SET").Range("H2").Value
    TechNm = myWs.Range("H2").Value
    counter = 0
    TechCount = 0


Do
    With myWs
        'If IsEmpty(Range("H2").Value) = True Then
        If IsEmpty(.Range("H2").Value) = True Then
                    Exit Do
        End If

        'If TechNm = ActiveWorkbook.Sheets("DATA SET").Range("H2").Offset(counter + 1, 0).Value Then
        If TechNm = .Range("H2").Offset(counter + 1, 0).Value Then
            counter = counter + 1

        'ElseIf TechNm <> ActiveWorkbook.Sheets("DATA SET").Range("H2").Offset(counter + 1, 0).Value Then
        ElseIf TechNm <> .Range("H2").Offset(counter + 1, 0).Value Then

                 'Create Worksheet with Tech Name
                wsNM = .Range("H2")
                Set Ws = Wb.Sheets.Add(after:=Wb.Sheets(Wb.Sheets.Count))
                Ws.Name = wsNM

                 'Copy Header Row to new worksheet
                'ActiveWorkbook.Sheets("DATA SET").Rows(1).EntireRow.Copy ActiveWorkbook.Sheets(wsNM).Range("A1")
                .Rows(1).EntireRow.Copy Ws.Range("A1")
                 'Move Tech assignments to new sheet
                **ActiveWorkbook.Sheets("DATA SET").Range("A" & TechCount & ":A" & counter).EntireRow.Copy ActiveWorkbook.Sheets(wsNM).Range("A2")**
                .Range("A" & TechCount & ":A" & counter).EntireRow.Copy Ws.Range("A2")
                With Ws.Cells
                    'Cells.Select
                    'With Selection
                        .HorizontalAlignment = xlLeft
                        .VerticalAlignment = xlBottom
                        .WrapText = False
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = False
                        .EntireColumn.AutoFit


                    .Rows(1).EntireColumn.AutoFilter
                    '.Range("A2").Select
                    Application.CutCopyMode = False
                End With
                'Change Do Loop Parameters
                'ActiveWorkbook.Worksheets("DATA SET").Select
                counter = counter + 1
                TechCount = counter
                TechNm = .Range("H2").Offset(counter, 0).Value
        End If
    End With
Loop


'ActiveWorkbook.Worksheets("TECH ASSIGNMENTS").Select
Wb.Worksheets("TECH ASSIGNMENTS").Activate
End Sub