ich habe ein weiteres Problem und hoffe auf eure Unterstützung. (die letzten beiden Male hat es sehr gut geklappt!Großes Lob)
Ich habe eine lange (dynamische in Zeilen zwischen 2.000-80.000 Zeilen) Rohdatentabelle ("Export"), Spalten A:M).
Diese würde ich gerne als Tabelle (Strg + T) umwandeln (soll im Nachhinhein auch genutzt werden inkl. Filterfunktion).
Aus dieser "Tabelle 5" möchte ich die ersten 15 sichtbaren Zeilen bestimmter spalten kopieren und in eine vorgefertigte Übersichtsblatt kopieren.
Gefiltert wird eine Spalte (groß nach klein), diese wird im Anschluss ausgeblendet und dann eine weitere Spalte gefiltert. (1.Umsatz dieses Jahr, 2.Umsatz letztes Jahr, 3.Umsatz 2. jahre)
Bisher habe ich es nicht wirklich hinbekommen, nur die ersten 15 Zeilen direkt in die vorgefertigte Maske zu kopieren und habe mir mit einem Behelfsblatt geholfen von dem ich dann die ersten 15 Zeilen markiert habe.
Teilcode für diese Prozedur:
Dim wksLaender As Worksheet
Dim Zeile As Long
Dim x As Long
Dim wksExport As Worksheet
Set wksExport = ActiveWorkbook.Worksheets("Export")
'Tabelle vorbereiten
wksExport.Select
wksExport.Range("A:A,E:E,G:G,H:H,I:I,K:K,N:N,O:O,P:P,Q:Q,R:R,V:V,W:W,X:X,Y:Y,Z:Z,AA:AA,AB: _
AB,AC:AC").Delete Shift:=xlToLeft
Columns("A:A").Cut
Columns("N:N").Insert Shift:=xlToRight
Columns("E:E").Cut
Columns("N:N").Insert Shift:=xlToRight
wksExport.ListObjects.Add(xlSrcRange, Range("A1:M" & _
ActiveSheet.UsedRange.Rows.Count), , xlYes).name = _
"Tabelle5"
wksExport.ListObjects("Tabelle5").Sort.SortFields. _
Clear
wksExport.Range("O1").Formula = "=SUBTOTAL(109,F2:F100000)" 'Sales CY
wksExport.Range("P1").Formula = "=SUBTOTAL(109,G2:G100000)" 'Sales 1Y
wksExport.Range("Q1").Formula = "=SUBTOTAL(109,H2:H100000)" 'Sales 2Y
wksExport.Range("R1").Formula = "=SUBTOTAL(109,I2:I100000)" 'Budget 1Y
wksExport.Range("S1").Formula = "=SUBTOTAL(109,J2:J100000)" 'Budget CY
wksExport.Range("T1").Formula = "=SUBTOTAL(109,K2:K100000)" 'Budget NY
wksExport.Range("U1").Formula = "=SUBTOTAL(109,E2:E100000)" 'Potential
' Kann man hier auch das Tabellenende nehmen?
' Es sollte halt ab Zeile 2 beginnen, da Zeile 1 Ja überschrift ist
Nun wird eine Schleife aktiviert, die je nach land ein eigenes Tabellenblatt erstellt und nun Daten aus "Tabelle 5" abgreift.Info: "Sales_Customer_land" ist das vorgefertigte Übersichtsblatt
Sub SchleifeDatenLand2(strLand As String, strLandName As String, strLandKurz As String)
Dim wksExport As Worksheet
Dim wksLand As Worksheet
Dim wksNeu As Worksheet
Dim LandCode As Range
Set wksExport = ActiveWorkbook.Worksheets("Export")
Dim rngScr As Range
Set rngScr = Sheets("Export").Range("O1")
'Sortierung zurücksetzen und alle daten anzeigen
With wksExport.ListObjects("Tabelle5")
.Sort.SortFields.Clear
If .AutoFilter.FilterMode = True Then
.AutoFilter.ShowAllData
End If
End With
'Prüfen, ob Gefilterte Daten vorhanden sind
With wksExport
Set LandCode = .Columns(12).Find(What:=strLand, LookIn:=xlValues, lookat:=xlWhole)
End With
If LandCode Is Nothing Then
GoTo NextLand
End If
'Schleife
Sheets("Sales_Customer_Ranking").Copy After:=Sheets(1)
Set wksLand = Sheets("Sales_Customer_Ranking (2)")
wksLand.name = strLandKurz
Worksheets("Export").ListObjects("Tabelle5").Range.AutoFilter Field:=12, _
Criteria1:=strLand
'THIS YEAR
wksExport.Activate
wksExport.ListObjects("Tabelle5").Sort.SortFields. _
Add Key:=Range("Tabelle5[[#All],[SALES_CY]]"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With wksExport.ListObjects("Tabelle5").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Set wksNeu = Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
wksNeu.name = "NeuesBlatt"
wksExport.Range("A2:F100000").SpecialCells(xlCellTypeVisible).Copy wksNeu.Range("A1")
wksExport.Range("J2:K100000").SpecialCells(xlCellTypeVisible).Copy wksNeu.Range("G1")
wksNeu.Range("A1:F15").Copy
wksLand.Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wksNeu.Range("G1:H15").Copy
wksLand.Range("I9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With wksLand
.Select
.Range("J2").NumberFormat = "DD.MM.YYYY"
.Range("J2").Value = Date
.Range("C3") = Sheets("Export").Range("M2")
.Range("C4") = strLandName
.Range("G25") = rngScr.Value
.Range("F25") = rngScr.Offset(0, 6).Value
.Range("I25") = rngScr.Offset(0, 4).Value
.Range("J25") = rngScr.Offset(0, 5).Value
End With
wksExport.Columns("F:F").EntireColumn.Hidden = True
'LAST YEAR
wksExport.Activate
wksExport.ListObjects("Tabelle5").Sort.SortFields. _
Clear
wksExport.ListObjects("Tabelle5").Sort.SortFields. _
Add Key:=Range("Tabelle5[[#All],[SALES_1Y]]"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With wksExport.ListObjects("Tabelle5").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
wksExport.Range("A2:G100000").SpecialCells(xlCellTypeVisible).Copy wksNeu.Range("A1")
wksExport.Range("I2:I100000").SpecialCells(xlCellTypeVisible).Copy wksNeu.Range("G1")
wksNeu.Range("A1:G15").Copy
wksLand.Range("B28").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With wksLand
.Select
.Range("G44") = rngScr.Offset(0, 1).Value
.Range("H44") = rngScr.Offset(0, 3).Value
.Range("F44") = rngScr.Offset(0, 6).Value
End With
wksExport.Columns("G:G").EntireColumn.Hidden = True
'TWO YEARS AGO
wksExport.ListObjects("Tabelle5").Sort.SortFields. _
Clear
wksExport.ListObjects("Tabelle5").Sort.SortFields. _
Add Key:=Range("Tabelle5[[#All],[SALES_2Y]]"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With wksExport.ListObjects("Tabelle5").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
wksExport.Range("A1:H100000").SpecialCells(xlCellTypeVisible).Copy wksNeu.Range("A1")
wksNeu.Range("A1:F15").Copy
wksLand.Range("B47").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wksNeu.Delete
With wksLand
.Select
.Range("F63") = rngScr.Offset(0, 6).Value
.Range("G63") = rngScr.Offset(0, 2).Value
End With
wksExport.Cells.EntireColumn.Hidden = False
NextLand:
End Sub
Gibt es die Möglichkeit, diesen Code so zu verkürzen/umzubauen, dass ich mir das Behelfsblatt sparen kann und direkt in wksLand kopieren kann?