Tabellen umsortieren per Formel oder Makro

Hallo zusammen,
ich verzweifle mal wieder an etwas vermeintlich einfachem:
Ich habe CSV Files für drei Marken mit dementsprechenden Einträgen, die jeweils für drei Filialen gelistet sind.
Diese möchte ich mittels Formel oder Makro umsortieren, so dass ich drei Filialen mit jeweils drei Marken erhalte.
Beispieldatei: https://www.herber.de/bbs/user/128342.xlsx
Die Beispieltabelle ist sehr klein, die richtige Tabelle mit vielen Einträgen gefüllt.
Ziel ist es, die Einträge aus den ersten drei Tabellenblättern anhand der Spalte A in die letzten drei Tabellenblätter zu übertragen, so dass alle Einträge nach Filialen aufgeteilt sind.
Ich denke, bei ca. 40.000 Datenzeilen über alle drei Marken empfiehlt sich ein Makro. Aber wie muss das aussehen?
Danke vorab!
Beste Grüße
Ralf

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Ralf,
unter Verwendug des Autofilters könnte man das bei 9 mal Filtern und kopieren auch schnell von Hand lösen.
Nachfolemd ein entsprechendes Makro.
LG
Franz


Sub Umkopieren()
Dim arrFiliale, intF As Integer, varFiliale
Dim wksMarke As Worksheet, intM As Integer
Dim wksFiliale As Worksheet, spaMarke As Long
Dim Zeile_L As Long, Zeile_F As Long
Dim StatusCalc As Long
arrFiliale = Array(7, 11, 12)
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
For intF = LBound(arrFiliale) To UBound(arrFiliale)
varFiliale = arrFiliale(intF)
Set wksFiliale = ActiveWorkbook.Worksheets("Filiale " & varFiliale)
Call prcSheetLeeren(wksFiliale)
spaMarke = wksFiliale.Cells(1, wksFiliale.Columns.Count).End(xlToLeft).Column
Zeile_F = 2 '1. zeile in die kopierte Daten eingefügt werden sollen
For intM = 1 To 3
Set wksMarke = ActiveWorkbook.Worksheets(intM)
With wksMarke
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
If .AutoFilterMode = False Then
.Range(.Rows(1), .Rows(Zeile_L)).AutoFilter
End If
.AutoFilter.Range.AutoFilter Field:=1, Criteria1:=varFiliale
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
If Zeile_L > 1 Then
.AutoFilter.Range.Copy wksFiliale.Cells(Zeile_F, 1)
With wksFiliale
'                        .Range(.Cells(Zeile_F, 1), .Cells(.Rows.Count, 1).End(xlUp)).Offset(0,  _
_
spaMarke)  = wksMarke.Name
.Rows(Zeile_F).Delete
Zeile_F = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With
End If
.ShowAllData
End With
Next intM
Next intF
For intM = 1 To 3
ActiveWorkbook.Worksheets(intM).AutoFilterMode = False
Next intM
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
MsgBox "Fertig"
End Sub
Sub prcSheetLeeren(wks As Worksheet, Optional Zeile_1 As Long = 1)
'Zeile_1 = Nummer der Zeile unterhalb der die Daten gelöscht werden sollen
Dim Zeile_L As Long
With wks
Zeile_L = .UsedRange.Row + .UsedRange.Rows.Count - 1
If Zeile_L > Zeile_1 Then
.Range(.Rows(Zeile_1 + 1), .Rows(Zeile_L)).Delete shift:=xlShiftUp
End If
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Tabellen umsortieren per Formel oder Makro

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellen umsortieren per Formel oder Makro

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread