Einsortieren von einem Arbeitsblatt
17.10.2018 17:31:30
einem
ich habe mir eine Makro erstellt das Arbeitsblätter erzeugt und befüllt. Soweit funktioniert alles, ich möchte aber das Arbeitsblatt in die Bestehenden Arbeitsblätter einsortieren. Das klappt irgendiwe nicht.
'Sortieralgorithmus
For sortier = 1 To ActiveWorkbook.Worksheets.Count
If Worksheets(strBlattname).Name Worksheets(strBlattname).Move Before:=Worksheets(sortier)
End If
Next sortier
Wobei strNlattname die Variable des Names des erzeugten Arbeitsblattes ist.
Später sollten dann nur die ersten fünf Zahlen ausgelesen werden, aber das mache ich ja mit Left(... .
hier noch der ganze Code
Sub Schaltfläche2_Klicken()
Dim Musterblatt As Worksheet
Dim strBlattname As String
Dim a1 As Integer 'Zählzahl
Dim Lauf As Integer 'Reihenbestimmung
Dim sortier As Integer 'sortieralgorithmus
Dim verk, verk2 As String 'sortieralgorithmus
Lauf = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
a1 = Cells(Lauf, 13)
Set Musterblatt = Worksheets("2.Musterblatt")
If a1 = 0 Then
strBlattname = Cells(Lauf, 2)
Musterblatt.Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = strBlattname
Worksheets("1.Übersicht").Cells(Lauf, 13) = a1
Cells(1, 1) = "Bemusterungsblatt" & " " & Worksheets("1.Übersicht").Cells(Lauf, 4)
Cells(1, 1).WrapText = True
Cells(5, 3) = Worksheets("1.Übersicht").Cells(3, 4)
Cells(6, 3) = Worksheets("1.Übersicht").Cells(Lauf, 4)
Cells(7, 3) = Year(Date) & "-" & Month(Date) & "-" & Day(Date) & "-" & Worksheets("1.Übersicht") _
_
.Cells(Lauf, 2)
Else
strBlattname = Cells(Lauf, 2) & "-" & a1
Musterblatt.Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = strBlattname
Cells(1, 1) = "Bemusterungsblatt" & " " & Worksheets("1.Übersicht").Cells(Lauf, 4)
Cells(1, 1).WrapText = True
Cells(5, 3) = Worksheets("1.Übersicht").Cells(3, 4)
Cells(6, 3) = Worksheets("1.Übersicht").Cells(Lauf, 4)
Cells(7, 3) = Year(Date) & "-" & Month(Date) & "-" & Day(Date) & "-" & Worksheets("1.Übersicht") _
_
.Cells(Lauf, 2) & "-" & a1
End If
a1 = a1 + 1
Worksheets("1.Übersicht").Cells(Lauf, 13) = a1
'Sortieralgorithmus
For sortier = 1 To ActiveWorkbook.Worksheets.Count
If Worksheets(strBlattname).Name