Копирование данных с одного листа на другой отсортировано

Question

Здравствуйте, я использую этот код для копирования определенных c записей с одного листа на другой. Допустим, я хочу отсортировать все данные в соответствии с записями из столбца 2 (от самой старой до самой новой даты). Как это возможно? Любые идеи? Спасибо!

Sub As_Of_Analysis_Sorting()
    Dim lr As Long, lr2 As Long, r As Long
    Set Sh1 = ThisWorkbook.Worksheets("service")
    Set Sh2 = ThisWorkbook.Worksheets("Copy")
    Sh1.Select

    Sh2.Cells(1, 1).Value = "1"
    Sh2.Cells(1, 2).Value = "2"
    Sh2.Cells(1, 3).Value = "3"
    Sh2.Cells(1, 4).Value = "4"
    Sh2.Cells(1, 5).Value = "5"
    Sh2.Cells(1, 6).Value = "6"
    Sh2.Cells(1, 7).Value = "7"
    Sh2.Cells(1, 8).Value = "8"
    Sh2.Cells(1, 9).Value = "9"
    Sh2.Cells(1, 10).Value = "10"
    Sh2.Cells(1, 11).Value = "11"
    Sh2.Cells(1, 12).Value = "12"
    Sh2.Cells(1, 13).Value = "13"
    Sh2.Cells(1, 14).Value = "14"
    Sh2.Cells(1, 15).Value = "15"
    Sh2.Cells(1, 16).Value = "16"


    lr = Sh1.Cells(Rows.Count, "A").End(xlUp).Row
    x = 2
    For r = 2 To lr
        If Range("C" & r).Value = "In Arbeit" Then
            Sh2.Cells(x, 1).Value = Sh1.Cells(r, 1).Value
            Sh2.Cells(x, 2).Value = Sh1.Cells(r, 2).Value
            Sh2.Cells(x, 3).Value = Sh1.Cells(r, 3).Value
            Sh2.Cells(x, 4).Value = Sh1.Cells(r, 4).Value
            Sh2.Cells(x, 5).Value = Sh1.Cells(r, 5).Value
            Sh2.Cells(x, 6).Value = Sh1.Cells(r, 6).Value
            Sh2.Cells(x, 7).Value = Sh1.Cells(r, 7).Value
            Sh2.Cells(x, 8).Value = Sh1.Cells(r, 8).Value
            Sh2.Cells(x, 9).Value = Sh1.Cells(r, 19).Value
            Sh2.Cells(x, 10).Value = Sh1.Cells(r, 29).Value
            Sh2.Cells(x, 11).Value = Sh1.Cells(r, 30).Value
            Sh2.Cells(x, 12).Value = Sh1.Cells(r, 31).Value
            Sh2.Cells(x, 13).Value = Sh1.Cells(r, 9).Value
            Sh2.Cells(x, 14).Value = Sh1.Cells(r, 14).Value
            Sh2.Cells(x, 15).Value = Sh1.Cells(r, 33).Value
            Sh2.Cells(x, 16).Value = Sh1.Cells(r, 16).Value
            x = x + 1
        End If
    Next r
    Sh2.Select
End Sub

Answer 1

Dy.Lee дал вам решение

Здесь я только хочу дать вам несколько советов, чтобы сделать ваш код более эффективным и (возможно) более читабельным и обслуживаемым

Sub As_Of_Analysis_Sorting()

    Dim Sh1 As Worksheet, Sh2 As Worksheet
    Set Sh1 = ThisWorkbook.Worksheets("service")
    Set Sh2 = ThisWorkbook.Worksheets("Copy")

    Dim lr As Long, lr2 As Long, r As Long, x As Long

    With Sh2
        For x = 1 To 14
            .Cells(1, x).Value = x
        Next
    End With

    lr = Sh1.Cells(Rows.Count, "A").End(xlUp).Row
    x = 2
    With Sh1
        For r = 2 To lr
            If Range("C" & r).Value = "In Arbeit" Then
                Sh2.Cells(x, 1).Resize(, 16).Value = Array( _
                                                    .Cells(r, 1).Value, _
                                                    .Cells(r, 2).Value, _
                                                    .Cells(r, 3).Value, _
                                                    .Cells(r, 4).Value, _
                                                    .Cells(r, 5).Value, _
                                                    .Cells(r, 6).Value, _
                                                    .Cells(r, 7).Value, _
                                                    .Cells(r, 8).Value, _
                                                    .Cells(r, 19).Value, _
                                                    .Cells(r, 29).Value, _
                                                    .Cells(r, 30).Value, _
                                                    .Cells(r, 31).Value, _
                                                    .Cells(r, 9).Value, _
                                                    .Cells(r, 14).Value, _
                                                    .Cells(r, 33).Value, _
                                                    .Cells(r, 16).Value)
                x = x + 1
            End If
        Next
    End With

    Sh2.Select
End Sub

и просто добавить раствор Dy.Lee внизу

Answer 2

Добавьте следующее в конец кода.

Dim rngDB As Range

Set rngDB = Sh2.Range("a1").CurrentRegion
With rngDB
    .Sort .Range("b1"), xlAscending, Header:=xlYes
End With