Hallo ich möchte die folgende Sortierfunktion für die Tabelle1 in das nachstehende Sub implementieren. Die Sortierung sollte aber vor Start der Zuordnung ablaufen. Ich benötige diese in einem Sub, weil dieses über einen Button ausgelöst wird.

Danke Euch
Mikka

Sub EineEbeneSortieren()
Worksheets("Tabelle1").Sort.SortFields.Clear
Range("B6:R260").Sort Key1:=Range("E6"), Header:=xlAscending
End Sub

Soll zu Beginn in das folgende Sub eingebaut werden.

Sub TabelleImportieren()

' Collection Worksheets Kosten
Dim c As New Collection
c.Add costarea11, "11"
c.Add costarea12, "12"
c.Add costarea21, "21"
c.Add costarea22, "22"
c.Add costarea31, "31"
c.Add costarea32, "32"
c.Add costarea41, "41"
c.Add costarea42, "42"

' Laufvariable Löschen
Dim s As Long

'Startzeile und Spaltenbereich zu loeschen
Dim startzeile As Long
Dim startspalte As Long
Dim endspalte As Long

startzeile = 10
startspalte = 2
endspalte = 11

'Loop Durch WorksheetCollection
For s = 1 To c.Count
With c(s)
.Range(.Cells(startzeile, startspalte), .Cells(.Cells(startzeile, startspalte).End(xlDown).Row, endspalte)).ClearContents
End With
Next s

'Durchlaufen der InhaltsTabelle und Kopieren der Zeilen
'Parameter Startzeile und Spalte der Daten in der Inhaltstabelle (oben links)
Dim startzeile As Long
Dim startspalte As Long
startzeile = 6
startspalte = 2

'Parameter rechteste Spalte
Dim endspalte As Long
endspalte = 18

'Mapping der Spalten der Inhaltstabelle (index) zu der jeweiligen Spalte in der Tabelle des Gebiets
Dim spaltenmap(1 To 18) As Long
spaltenmap(1) = 0
spaltenmap(2) = 0
spaltenmap(3) = 0
spaltenmap(4) = 7
spaltenmap(5) = 2
spaltenmap(6) = 0
spaltenmap(7) = 3
spaltenmap(8) = 4
spaltenmap(9) = 5
spaltenmap(10) = 8
spaltenmap(11) = 6
spaltenmap(12) = 0
spaltenmap(13) = 9
spaltenmap(14) = 0
spaltenmap(15) = 10
spaltenmap(16) = 0
spaltenmap(17) = 0
spaltenmap(18) = 11

'Spalte mit ID/Areacode
Dim idspalte As Long
idspalte = 2

'Laufvariable zum Durchlaufen der Inhaltstabelle
'Var Zeile
Dim vz As Long

'Var Spalte
Dim vs As Long

'Variable zum Speichern der letzten 2 Ziffern des ID-Keys
Dim akey As String

'Variable zum Speichern der Targetrow auf der zu beschreibenden Gebietsseite
Dim targetrow As Long

'Workaround: Collection zum Übersetzen der Gebietsnummer zum Index des Arrays zum Speichern der genutzten Zeilennummer pro Gebietsseite
Dim zunutzendezeilemap As New Collection
zunutzendezeilemap.Add 1, "11"
zunutzendezeilemap.Add 2, "12"
zunutzendezeilemap.Add 3, "21"
zunutzendezeilemap.Add 4, "22"
zunutzendezeilemap.Add 5, "31"
zunutzendezeilemap.Add 6, "32"
zunutzendezeilemap.Add 7, "41"
zunutzendezeilemap.Add 8, "42"

Dim zunutzendezeile(1 To 8) As Long
For j = 1 To 8
zunutzendezeile(j) = startzeile
Next j

'Schleife zum Durchlaufen der Zeilen der Inhaltstabelle, extrahieren der letzten zwei Ziffern des Gebietsnummernstrings
'Bestimmung der zu beschreibenden Zeile in der Gebietstabelle, Durchlaufen der Spalten und Kopieren des Werts, falls Spalte gemapped (>0)
For vz = startzeile To table.Cells(startzeile, startspalte).End(xlDown).Row
akey = Right(table.Cells(vz, idspalte).Value, 2)
targetrow = zunutzendezeile(zunutzendezeilemap(akey))
zunutzendezeile(zunutzendezeilemap(akey)) = zunutzendezeile(zunutzendezeilemap(akey)) + 1
For vs = startspalte To endspalte
If spaltenmap(vs) > 0 Then
c(akey).Cells(targetrow, spaltenmap(vs)).Value = Inhaltstable.Cells(vz, vs).Value
End If
Next vs
Next vz

End Sub