Erstellen Sie für jeden einzelnen Agenten ein neues Blatt und verschieben Sie alle Daten auf jedes Blatt

Ich habe dieses Problem, das ich zu lösen versuche. Jeden Tag erhalte ich einen Bericht mit Daten, die ich weiterleiten muss. Um es ein bisschen einfacher zu machen, habe ich versucht, ein Makro zu finden, das ein neues Blatt mit dem Namen des Agenten erstellt und die Daten für jeden Agenten im erstellten Blatt verschiebt ...

Ich habe eine gefunden, die so ziemlich das tun soll. Da dies jedoch nicht wirklich mein Fachgebiet ist, kann ich es nicht ändern, um meine Anfrage zu bearbeiten, und wahrscheinlich sogar zum Funktionieren bringen. Hat jemand eine Idee?

Const cl& = 2
Const datz& = 1

Dim a As Variant, x As Worksheet, sh As Worksheet
Dim rws&, cls&, p&, i&, ri&, j&
Dim u(), b As Boolean, y

Application.ScreenUpdating = False
Sheets("Sheet1").Activate
rws = Cells.Find("*", , , , xlByRows, xlPrevious).Row
cls = Cells.Find("*", , , , xlByColumns, xlPrevious).Column

Set x = Sheets.Add(After:=Sheets("Sheet1"))
Sheets("Sheet1").Cells(1).Resize(rws, cls).Copy x.Cells(1)
Set a = x.Cells(1).Resize(rws, cls)
a.Sort a(1, cl), 2, Header:=xlYes
a = a.Resize(rws + 1)
p = 2

For i = p To rws + 1
    If a(i, cl) <> a(p, cl) Then
        b = False
        For Each sh In Worksheets
            If sh.Name = a(p, cl) Then b = True: Exit For
        Next
        If Not b Then
            Sheets.Add.Name = a(p, cl)
            With Sheets(a(p, cl))
                x.Cells(1).Resize(, cls).Copy .Cells(1)
                ri = i - p
                x.Cells(p, 1).Resize(ri, cls).Cut .Cells(2, 1)
                .Cells(2, 1).Resize(ri, cls).Sort .Cells(2, datz), Header:=xlNo
                y = .Cells(datz).Resize(ri + 1)
                ReDim u(1 To 2 * ri, 1 To 1)
                For j = 2 To ri
                    u(j, 1) = j
                    If y(j, 1) <> y(j + 1, 1) Then u(j + ri, 1) = j
                Next j
                .Cells(cls + 1).Resize(2 * ri) = u
                .Cells(1).Resize(2 * ri, cls + 1).Sort .Cells(cls + 1), Header:=xlYes
                .Cells(cls + 1).Resize(2 * ri).ClearContents
            End With
        End If
        p = i
    End If
Next i


Application.DisplayAlerts = False
    x.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

Dies ist ein Beispiel für meinen Bericht, den ich erhalteBeispie

Ich bekomme immer wieder Fehler in der Zeile: a.Sort a (1, cl), 2, Header: = xlYes Das in sich weiß ich nicht wirklich, was es tut. Kann mir jemand erklären?

Antworten auf die Frage(4)

Ihre Antwort auf die Frage