Ladebalken ProgressBar

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
UserForm Label MsgBox
Bild

Betrifft: Ladebalken ProgressBar
von: Noureddine
Geschrieben am: 26.09.2015 16:29:57

Hallo,
ich habe ein Makro das einige Minuten benötigt. Um den Anwender zu Informieren dass, das Porgramm nicht abgestürtzt ist, will ich wärend der Laufzeit eine ProgressBar einbauen. Im Internet habe ich einige Vorschläge gefunden, jedoch möchte ich dies verstehen. Könnte mir hier jemand dies Erklären? Ich wäre sehr dankbar dafür.
Sollte nichts ansprucvolles sein. Ein Balken mit der entsprechenden Prozentangabe.
Vielen Dank vorab.

Bild

Betrifft: AW: Ladebalken ProgressBar
von: Peter Feustel
Geschrieben am: 26.09.2015 16:42:33
Hallo Noureddine,
mit der Status Bar kannst du ohne großen Aufwand deine Anwender vom Leben deiner Mappe unterrichten.
Application.StatusBar = "deine Text und deine Prozentzahl"
am Ende des Makros Application.StatusBar = False nicht vergessen.
Gruß Peter

Bild

Betrifft: AW: Ladebalken ProgressBar
von: Noureddine
Geschrieben am: 26.09.2015 16:46:30
Danke für die schnelle Antwort.
Dies habe ich bereits aktuell in der Anwendung. Find ich aber nicht als die ideale Lösung, da Sie nur unten links klein angezeigt wird.
Deswegen hier mein Beitrag, ich möchte gern ein Schritt weiter gehen...
Im Makro selbst sind mehrer Schleifen vorhanden, aber das Makro an sich wird nur einmal durchgeführt.

Bild

Betrifft: AW: Ladebalken ProgressBar
von: Daniel
Geschrieben am: 26.09.2015 17:03:11
Hi
du kannst einen Progressbar nur dann selbstständig anzeigen lassen, wenn du eine Schleife hast oder ein laufendes Makro, dh wenn du durch einen Programmschritt die Progressbar aktualisieren kannst:

For i = 1 to 100
   Progressbar = Progressbar + 1
   hier dein Code
Next
oder
Programmteil 1
Progressbar = Progressbar + 1
Programmteil 2
Progressbar = Progressbar + 1
Programmteil 3
Progressbar = Progressbar + 1
du kannst keine eigene Progressbar anzeigen lassen, wenn ein einzelnen Befehl einen längerdauernden Prozess auslöst (z.B. öffnen einer grösseren Datei, aktualisieren von Datenbankabfragen ggf aus dem Internet, Neuberechnen von Zellen)
in diesen Fällen bist du auf die von Excel automatisch in der Statusleiste angezeigten Fortschrittsbalken angewiesen.
sollte der Fall 1 zurtreffen, dann hast du zwei möglichkeiten:
a) die Statusleiste
du kannst in der Statusleise eigene Texte anzeigen lassen, um so den Fortschritt zu dokumntieren.
hier kannst du nur Text anzeigen lassen ("Bearbeitet: 53%", "Schritt 1 von 10"), aber keine Grafik, dh Balken müsstest du durch wiederholen von Textzeichen darstellen.
Dim i As Long
For i = 1 To 100
   Application.StatusBar = "Bearbeitet: " & Format(i / 100, "0%") & _ 
                              " " & String(10 * i / 100, "X")
   Application.Wait Now + TimeSerial(0, 0, 1)
Next
Application.StatusBar = False
b1) Userform mit Steuerelement "Progressbar"
du kannst eine userform erstellen und auf dieser das Steuerelement "Progressbar" einfügen (findet sich in der Werkzeugleiste der Userform, ggf musst du über das Kontextmenü der Werkzeugleiste das Steuerelement in den weitern Steuerelementen suchen, um es verfügbar zu machen)
dieser Progressbar weist du dann einfach je nach Fortschritt einen Wert von 0-100 zu und bekommst den jeweiligen Balken (Progressbar.Value = 43)
b2) Userform mit Label
erstelle eine Userform mit einen Label.
gib den Label eine Farbe.
Verändere bei Programmfortschritt die breite des labels (Label1.Width = 123)
bei den Userformmethoden musst du beachten, wie Userform und dein Code zusammenspielen.
Wenn der Arbeitscode nicht bestandteil der Userform ist, muss diese auf jeden Fall die Eigenschaft "ShowModal = False" sein, damit der Makrocode laufen kann, wärend die Userform geöffnet ist.
ggf kann es sein, dass VBA lieber den Code weiter ausführt, als sich um die Bildschirmdarstellung zu kümmern. In diesem Fall kann man ein Userform1.Repaint einsetzen, damit VBA die Userform aktuell neu zeichnet.
Gruss Daniel

Bild

Betrifft: AW: Ladebalken ProgressBar
von: Noureddine
Geschrieben am: 26.09.2015 20:07:25
Hallo Daniel,
ich werde wahrscheinlich die b1-Variante nehmen.
Vielen Dank.

Bild

Betrifft: AW: Ladebalken ProgressBar
von: matthias
Geschrieben am: 26.09.2015 20:05:49
Hallo Noureddine,
du musst zunächst definieren wie genau dein Fortschritt ermittelt werden soll. Die Prozentzahl kommt ja nicht von irgendwo zugeflogen, nehme ich an. Meist hat man Schleifen, deren Durchgänge man im Vorhinein bestimmen kann. Mit jedem Durchlauf lässt man dabei einen Zähler mitlaufen. Der Fortschritt ist dann Zähler/AnzahlDurchgänge.
Am besten wäre du würdest uns dein Makro zur Verfügung stellen, günstigerweise mit Beispieldatei, dann können wir dir dabei helfen, eventuell sogar noch etwas optimieren um den Ablauf zu beschleunigen.
lg Matthias

Bild

Betrifft: AW: Ladebalken ProgressBar
von: Michael
Geschrieben am: 27.09.2015 14:02:27
Hallo,
kann man diese Anzeige auch mitten oder in A1(MSG Box) im Tabellenblatt laufen lassen?
Denn ganz unten schaut keiner hin.

Bild

Betrifft: AW: Ladebalken ProgressBar
von: matthias
Geschrieben am: 27.09.2015 20:12:41
Hallo Michael,
deine Art MsgBox wäre Möglichkeit B von Daniels Vorschlägen. Eine Userform ist ein Fenster welches sich öffnet und in dem dein Balken dann fortschreitet.
lg Matthias

Bild

Betrifft: AW: Ladebalken ProgressBar
von: Michael
Geschrieben am: 27.09.2015 20:17:36
Hallo Matthias,
wie geht das ?

Bild

Betrifft: AW: Ladebalken ProgressBar
von: matthias
Geschrieben am: 28.09.2015 13:27:15
Hallo Michael,
https://www.herber.de/bbs/user/100441.xlsm
Zu den grafischen Objekten hat Sepp bereits eine optisch viel schönere Lösung geäußert, jedoch muss man dazu sagen, dass dies nicht die optimalste Variante inpunkto Geschwindigkeit ist.
Eine Userform kann man genau wie ein Modul mit "Rechtsklick" -> "Einfügen" im Projekt-Explorer erstellen. Mit einem Doppelklick auf die Userform gelangst du in den Code-Bereich der Form.
Zur genaueren Bedienung verweise ich jedoch auf die Suchfunktion des Forums bzw. Google.
Eine Grundstruktur wie man so eine Progressbar anlegen kann, siehst du sowohl bei Sepp's als auch meiner Lösung. Daniels Tipps sind dabei Gold wert.
Zum Schluss kann ich mich nur nochmal wiederholen: Wir helfen euch gern dabei, jedoch ist dies erheblich leichter, wenn man uns Beispielmappen und Makros zur Verfügung stellt.
lg Matthias

Bild

Betrifft: AW: Ladebalken ProgressBar
von: Sepp
Geschrieben am: 27.09.2015 22:52:15
Hallo Noureddine,
ein einfaches Beispiel.
https://www.herber.de/bbs/user/100432.xlsm

Gruß Sepp


Bild

Betrifft: Beispiel Code
von: Michl
Geschrieben am: 29.09.2015 02:14:40
Hallo,
anbei mein Code.
Leider darf ich von der Arbeit aus meine Datei nicht hochladen.

Sub freieLagerplätze()
'
' Makro1 Makro
'
'
    Sheets("Tabelle1").Select
    Sheets("Tabelle1").Name = "WH25"
    Range("B36").Select
         Workbooks.OpenText Filename:="G:\Transfer\Allgemein\Datei Txt\freie Lagerplätze WH25. _
txt", Origin:=xlWindows, _
        StartRow:=9, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(10 _
        , 1)), TrailingMinusNumbers:=True
    Columns("A:B").Select
    Selection.Copy
    Windows("Anzahl freie Lagerplätze Neu.xlsb").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Range("D11").Select
    Sheets("Tabelle2").Select
    Sheets("Tabelle2").Name = "GD65"
    Range("C34").Select
    Workbooks.OpenText Filename:="G:\Transfer\Allgemein\Datei Txt\freie Lagerplätze GD65.txt",  _
Origin:=xlWindows, _
        StartRow:=7, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:=";", FieldInfo:=Array(Array(1, 1 _
        ), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Columns("A:C").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Anzahl freie Lagerplätze Neu.xlsb").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Range("G12").Select
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Sheets("Tabelle3").Select
    Sheets("Tabelle3").Name = "RB umwandeln"
    Range("C30").Select
    ChDir "G:\Transfer\Allgemein\WE"
    Workbooks.Open Filename:= _
        "G:\Transfer\Allgemein\WE\Makro frei Lagerplätze.xlsb"
    Sheets("RB umwandeln").Select
    Columns("A:B").Select
    Range("A166").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Anzahl freie Lagerplätze Neu.xlsb").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Range("D13").Select
    Sheets("Tabelle4").Select
    Sheets("Tabelle4").Name = "belegte Lagerplätze"
    Range("D39").Select
    Application.CutCopyMode = False
    Workbooks.Open Filename:= _
        "G:\Transfer\Allgemein\WE\Makro frei Lagerplätze.xlsb"
    ActiveWindow.SmallScroll Down:=-15
    Sheets("belegte Lagerplätze").Select
    ActiveWindow.SmallScroll Down:=-144
    Columns("A:B").Select
    Selection.Copy
    Windows("Anzahl freie Lagerplätze Neu.xlsb").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D11").Select
        Sheets("GD65").Select
        Sheets("Tabelle5").Select
    Sheets("Tabelle5").Name = "Maße Rollregal"
  Workbooks.Open Filename:= _
        "G:\Transfer\Allgemein\WE\Makro frei Lagerplätze.xlsb"
     Sheets("Maße Rollregal").Select
    Columns("A:C").Select
    Selection.Copy
    Windows("Anzahl freie Lagerplätze Neu.xlsb").Activate
    Range("H41").Select
    Sheets("Maße Rollregal").Select
    Range("A1").Select
    ActiveSheet.Paste
        Sheets("Tabelle6").Select
    Sheets.Add
    Sheets("Tabelle1").Select
    Sheets("Tabelle1").Name = "Auswertung"
    Range("G37").Select
    Sheets("Auswertung").Select
Range("D11").Select
        
    Application.Run "PERSONAL.xlsm!freieLagerplätze1"
    Application.Run "PERSONAL.xlsm!freieLagerplätze2"
   Sheets("WH25").Select
    Application.Run "PERSONAL.xlsm!freieLagerplätze3"
Application.Run "PERSONAL.xlsm!freieLagerplätze4"
   
    Application.Run "PERSONAL.xlsm!freieLagerplätze6"
    Columns("C:C").ColumnWidth = 2.29
    Columns("C:C").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Columns("F:F").ColumnWidth = 2
    Columns("F:F").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Columns("J:J").ColumnWidth = 2
    Columns("J:J").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("K4").Select
    Application.Run "PERSONAL.xlsm!freieLagerplätze7"
     Range("K4").Select
End Sub
Entwas langer Code, da ich mich in VBA nicht so gut auskenne :-(
Kann man am Anfang so einen Balken laufen lassen( in meinem Code) per MSG Box oder so ?
Danke euch
Liebe Grüße Michl.

Bild

Betrifft: AW: Beispiel Code
von: Daniel
Geschrieben am: 29.09.2015 11:53:28
Hi
bei diesem Code solltest du dir nicht Gedanken über einen Fortschrittsbalken machen, sondern deine Zeit lieber investieren, um den Code zu beschleunigen.
lies dir das mal durch (und auch die dazugehörigen Folgeseiten):
http://www.online-excel.de/excel/singsel_vba.php?f=78
http://www.online-excel.de/excel/singsel_vba.php?f=60
als weiterer Hinweis:
versuche wenn möglich Zellen, die gleich bearbeitet werden, in einen Schritt gleichzeitig zu bearbeiten:

Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit

lässt sich in einem Schritt ausführen mit:
Columns("B:C").EntireColumn.AutoFit

dies funktioniert oft auch bei nicht zusammenhängendne Zellbereichen:
Columns("B:B,D:D,F:F").EntireColumn.AutoFit
Gruß Daniel

Bild

Betrifft: AW: Beispiel Code
von: matthias
Geschrieben am: 29.09.2015 17:02:28
Hallo Michl,
ich habe mir erlaubt deinen Code von etlichen Select-Aktionen zu entrümpeln und vorallem auch die geöffneten Mappen nach Bearbeitung zu schließen. Dies verbraucht alles Ressourcen!
Zusätzlich ist nun die Bildschirmaktualisierung und die Formel-Neuberechnung während der Laufzeit des Codes deaktiviert um das ganze zu beschleunigen.
Die Formatierung der Spalten zum Ende hin kann man ebenfalls zusammenfassen.
Kleiner Tipp: Eine einheitliche Struktur, Leerzeilen zur Trennung von zusammenhängenden Aktionen, Kommentare machen das Lesen erheblich leichter.

Sub freieLagerplätze()
Dim wksWH25 As Worksheet, wksGD65 As Worksheet, wksRB As Worksheet, wksLP As Worksheet, _
    wksMR As Worksheet, wksAusw As Worksheet
'Bildschirmaktualisierung + Formelberechnung aus
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Tabellenblätter festlegen
Set wksWH25 = ThisWorkbook.Sheets("Tabelle1")
Set wksGD65 = ThisWorkbook.Sheets("Tabelle2")
Set wksRB = ThisWorkbook.Sheets("Tabelle3")
Set wksLP = ThisWorkbook.Sheets("Tabelle4")
Set wksMR = ThisWorkbook.Sheets("Tabelle5")
Set wksAusw = Worksheets.Add(After:=wksMR)
wksWH25.Name = "WH25"
wksGD65.Name = "GD65"
wksRB.Name = "RB umwandeln"
wksLP.Name = "belegte Lagerplätze"
wksMR.Name = "Maße Rollregal"
wksAusw.Name = "Auswertung"
'Kopieren aus WH25
Workbooks.OpenText Filename:="G:\Transfer\Allgemein\Datei Txt\freie Lagerplätze WH25.txt", _
    Origin:=xlWindows, StartRow:=9, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
    Array(10, 1)), TrailingMinusNumbers:=True
Columns("A:B").Copy Destination:=wksWH25.Range("A1")
ActiveWorkbook.Close
 
'Kopieren aus GD65
Workbooks.OpenText Filename:="G:\Transfer\Allgemein\Datei Txt\freie Lagerplätze GD65.txt", _
    Origin:=xlWindows, StartRow:=7, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
    Other:=True, OtherChar:=";", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), _
    Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
Columns("A:C").Copy Destination:=wksGD65.Range("A1")
ActiveWorkbook.Close
wksGD65.Columns("B:C").EntireColumn.AutoFit
'Kopieren aus freie Lagerplätze
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Makro frei Lagerplätze.xlsb"
Sheets("RB umwandeln").Columns("A:B").Copy Destination:=wksRB.Range("A1")
Sheets("belegte Lagerplätze").Columns("A:B").Copy Destination:=wksLP.Range("A1")
wksLP.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Maße Rollregal").Columns("A:C").Copy Destination:=wksMR.Range("A1")
ActiveWorkbook.Close
'Auswertung
wksAusw.Select
Application.Run "PERSONAL.xlsm!freieLagerplätze1"
Application.Run "PERSONAL.xlsm!freieLagerplätze2"
wksWH25.Select
Application.Run "PERSONAL.xlsm!freieLagerplätze3"
Application.Run "PERSONAL.xlsm!freieLagerplätze4"
Application.Run "PERSONAL.xlsm!freieLagerplätze6"
'Formatierung
Columns("C").ColumnWidth = 2.29
Union(Columns("F"), Columns("J")).ColumnWidth = 2
With Union(Columns("C"), Columns("F"), Columns("J")).Interior
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
End With
Application.Run "PERSONAL.xlsm!freieLagerplätze7"
'Bildschirmaktualisierung + Formelberechnung ein
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Das Makro, ohne die Untermakros zu berücksichten, ist in unter 10 Sekunden erledigt. Ohne die anderen Makros näher zu kennen, lässt sich eine Progressbar in diesem Fall nicht wirklich empfehlen.
lg Matthias

Bild

Betrifft: Daniel, du hast Recht...Leider bin ich zu DOOF :-(
von: Michl
Geschrieben am: 29.09.2015 23:12:18
Hallo Matthias,
ohmannnn Danke ersteinmal für diene Hilfe.
Anbei meine weiteren Codes, bei Code freie Lagerplätze 2 kommt ein Fehler :

Sub freieLagerplätze1()
Dim loletzte As Long
Dim loA As Long
Dim dblSum As Double
Dim DblMitt As Double
loletzte = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
Application.EnableEvents = False
For loA = loletzte To 2 Step -1
    If Application.WorksheetFunction.CountIf(Range(Cells(2, 1), Cells(loA, 1)), Cells(loA, 1)) > _
 1 Then Rows(loA).Delete Shift:=xlUp
Next
End Sub

Sub freieLagerplätze2()
Dim lngZeile As Long
Dim lngLetzte As Long
lngZeile = 1
With Worksheets("WH25")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows. _
Count)
With .Range(.Cells(1, 1), .Cells(lngLetzte, 1))
Do
.Replace What:=Worksheets("RB umwandeln").Cells(lngZeile, 1).Value, _
Replacement:=Worksheets("RB umwandeln").Cells(lngZeile, 2).Value, lookat:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
lngZeile = lngZeile + 1
Loop While Worksheets("RB umwandeln").Cells(lngZeile, 1) <> ""
End With
End With
End Sub

Sub freieLagerplätze3()
    Dim loLetzte1 As Long
    Dim loLetzte2 As Long
    Dim i As Long, j As Long
    Dim raA As Range
    Dim wksA As Worksheet
    Dim wksB As Worksheet
    Set wksA = Sheets("WH25") ' Tabellennamen anpassen; Tabelle in der gelöscht wird
    Set wksB = Sheets("GD65") ' Tabellennamen anpassen; Tabelle in der die Werte in Spalte A  _
gelistet sind
    With wksB
        loLetzte2 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
    End With
    With wksA
        loLetzte1 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
        For i = 2 To loLetzte1
            For j = 2 To loLetzte2
                If Trim(.Cells(i, 1)) = Trim(wksB.Cells(j, 1)) Then
                    If raA Is Nothing Then
                        Set raA = Rows(i)
                    Else
                        Set raA = Union(raA, Rows(i))
                    End If
                End If
            Next j
        Next i
    End With
    If Not raA Is Nothing Then
        raA.Delete
        Set raA = Nothing
    End If
End Sub

Sub freieLagerplätze4()
    Dim loLetzte1 As Long
    Dim loLetzte2 As Long
    Dim i As Long, j As Long
    Dim raA As Range
    Dim wksA As Worksheet
    Dim wksB As Worksheet
    Set wksA = Sheets("WH25") ' Tabellennamen anpassen; Tabelle in der gelöscht wird
    Set wksB = Sheets("belegte Lagerplätze") ' Tabellennamen anpassen; Tabelle in der die Werte  _
in Spalte A gelistet sind
    With wksB
        loLetzte2 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
    End With
    With wksA
        loLetzte1 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
        For i = 2 To loLetzte1
            For j = 2 To loLetzte2
                If Trim(.Cells(i, 1)) = Trim(wksB.Cells(j, 1)) Then
                    If raA Is Nothing Then
                        Set raA = Rows(i)
                    Else
                        Set raA = Union(raA, Rows(i))
                    End If
                End If
            Next j
        Next i
    End With
    If Not raA Is Nothing Then
        raA.Delete
        Set raA = Nothing
    End If
End Sub
Sub freieLagerplätze6()
Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "test"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "KP2_CCG1"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "test"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "KP2_CCG2"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "test"
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "KD2_30x40"
    Range("C5").Select
    Sheets("Auswertung").Select
    Cells.Select
    Selection.ClearContents
    Sheets("Wh25").Select
    Range("C2").Select
    Application.Run "PERSONAL.xlsm!freieLagerplätzeAufteilen"
    Sheets("Auswertung").Select
    Columns("J:K").Select
    Selection.ClearContents
    Rows("4:4").Select
    Selection.Delete Shift:=xlUp
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Lagerplatz"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "Feldtyp"
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "Lagerplatz"
    Range("E3").Select
    ActiveCell.FormulaR1C1 = "Feldtyp"
    Range("G3").Select
    ActiveCell.FormulaR1C1 = "Lagerplatz"
    Range("H3").Select
    ActiveCell.FormulaR1C1 = "Feldtyp"
    Range("I3").Select
    ActiveCell.FormulaR1C1 = "Maße"
    Range("G1:I2").Select
    Range("I1").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Bold = True
    Columns("G:I").Select
    Range("G3").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("D1:E2").Select
    Selection.Style = "Comma"
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("D:E").Select
    Range("D3").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Columns("B:B").ColumnWidth = 11.57
    Range("A1:B2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("A:B").Select
    Range("A3").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("C1").Select
    Rows("3:3").RowHeight = 16.5
    Rows("2:2").RowHeight = 18.75
    Columns("C:C").ColumnWidth = 15.57
    Columns("C:C").ColumnWidth = 18.86
    Rows("1:1").RowHeight = 18
    Range("C1:C3").Select
    Range("C3").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("K1").Select
 Sheets("Auswertung").Select
    Sheets.Add
    Sheets("Auswertung").Select
    Sheets("Auswertung").Move Before:=Sheets(5)
Columns("C:C").ColumnWidth = 7.29
    Columns("C:C").ColumnWidth = 7
    Columns("C:C").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Columns("F:F").ColumnWidth = 7
    Columns("F:F").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Columns("J:J").ColumnWidth = 7
    Columns("J:J").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Columns("F:F").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Columns("C:C").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Columns("J:J").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Columns("J:J").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Columns("J:J").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Auswertung"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "KP2_CCG2"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "KP2_CCG1"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "KD2_30x40"
    Range("L1:N1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("L1:N2").Select
    Selection.Font.Bold = True
    Range("L1:N1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("L2:N2").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("N5").Select
    Columns("L:L").EntireColumn.AutoFit
    Columns("M:M").EntireColumn.AutoFit
    Columns("N:N").EntireColumn.AutoFit
    Range("L1:N1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("L2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("M2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("N2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("L1:N3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("L3").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C[-10]:R[996]C[-10])"
    Range("M3").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C[-8]:R[996]C[-8])"
    Range("N3").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C[-6]:R[996]C[-6])"
    Range("L3:N3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("O6").Select 'hier kommtrein
End Sub

Sub freielagerplätze7()
'
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.ColumnWidth = 12
    Range("C1:C2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("C1:C2").Select
    ActiveCell.FormulaR1C1 = "Info"
    Columns("C:C").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.ColumnWidth = 12
    Range("G1:G2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("G1:G2").Select
    ActiveCell.FormulaR1C1 = "Info"
    Columns("G:G").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.ColumnWidth = 12
    Range("L1:L2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "Info"
    Columns("L:L").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Columns("C:C").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("C1:C2").Select
    Selection.Font.Bold = True
    Columns("N:N").ColumnWidth = 6
    Columns("R:R").ColumnWidth = 20
Columns("C:C").Select
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("C1:C2").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Columns("G:G").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Range("G1:G2").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    Columns("L:L").Select
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("L1:L2").Select
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("N4").Select
 Range("S1:U1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Columns("S:U").Select
    Range("S2").Activate
    Selection.ColumnWidth = 4
    Columns("S:U").Select
    Range("S2").Activate
    Selection.Font.Bold = True
    Range("S1:U2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.AutoFill Destination:=Range("S1:AV2"), Type:=xlFillDefault
    Range("S1:AV2").Select
    ActiveWindow.ScrollColumn = 32
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    Range("S2:AV3").Select
    Range("S3").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Columns("S:AV").Select
    Range("S2").Activate
    Selection.ColumnWidth = 4
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "C2"
    Range("T2").Select
    ActiveCell.FormulaR1C1 = "C1"
    Range("U2").Select
    ActiveCell.FormulaR1C1 = "KD"
    Range("S2:U2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("S2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("T2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("U2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("S1:U1").Select
    ActiveCell.FormulaR1C1 = "Lager 10"
    Range("U2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("S2:U2").Select
    Selection.AutoFill Destination:=Range("S2:AV2"), Type:=xlFillCopy
    Range("S2:AV2").Select
    Range("S1:U1").Select
    Selection.AutoFill Destination:=Range("S1:AS1"), Type:=xlFillDefault
    Range("S1:AS1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AT1:AV1").Select
    ActiveCell.FormulaR1C1 = "Tabakhalle"
    Range("AT1:AV1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("V3:X3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("AB3:AD3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("AH3:AJ3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("AN3:AP3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("AT3:AV3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("S3:AV3").Select
    Range("AV3").Activate
    Selection.Font.Bold = True
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Range("V1:X1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("AB1:AD1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("AH1:AJ1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("AN1:AP1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("AT1:AV1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("AH1:AJ1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("AB1:AD1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("V1:X1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("V3:X3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("AB3:AD3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("AH3:AJ3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("AN3:AP3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("AT3:AV3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("S6:Y7").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "Rollregal"
    Range("S6:Y7").Select
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("S8:U8").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("V8:W8").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("X8:Y8").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("S8:Y8").Select
    Selection.AutoFill Destination:=Range("S8:Y21"), Type:=xlFillDefault
    Range("S8:Y21").Select
    Range("S6:Y21").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("S8:U8").Select
    ActiveCell.FormulaR1C1 = "Gang"
    Range("S8:U8").Select
    Selection.AutoFill Destination:=Range("S8:U21"), Type:=xlFillDefault
    Range("S8:U21").Select
    Range("V8:W8").Select
    ActiveCell.FormulaR1C1 = "12"
    Range("V9:W9").Select
    ActiveCell.FormulaR1C1 = "14"
    Range("V10:W10").Select
    ActiveCell.FormulaR1C1 = "44"
    Range("V11:W11").Select
    ActiveCell.FormulaR1C1 = "46"
    Range("V12:W12").Select
    ActiveCell.FormulaR1C1 = "53"
    Range("V13:W13").Select
    ActiveCell.FormulaR1C1 = "61"
    Range("V14:W14").Select
    ActiveCell.FormulaR1C1 = "62"
    Range("V15:W15").Select
    ActiveCell.FormulaR1C1 = "64"
    Range("V16:W16").Select
    ActiveCell.FormulaR1C1 = "66"
    Range("V17:W17").Select
    ActiveCell.FormulaR1C1 = "67"
    Range("V18:W18").Select
    ActiveCell.FormulaR1C1 = "69"
    Range("V19:W19").Select
    ActiveCell.FormulaR1C1 = "70"
    Range("V20:W20").Select
    ActiveCell.FormulaR1C1 = "72"
    Range("V21:W21").Select
    ActiveCell.FormulaR1C1 = "74"
    Range("S21:Y21").Select
    Selection.AutoFill Destination:=Range("S21:Y23"), Type:=xlFillFormats
    Range("S21:Y23").Select
    Range("S21:U21").Select
    Selection.AutoFill Destination:=Range("S21:U23"), Type:=xlFillDefault
    Range("S21:U23").Select
    Range("V22:W22").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("V23:W23").Select
    ActiveCell.FormulaR1C1 = "3"
    Range("S22:U22").Select
    ActiveCell.FormulaR1C1 = "Tabak  Gang"
    Range("S23:U23").Select
    ActiveCell.FormulaR1C1 = "Tabak  Gang"
    Range("V8:W23").Select
    Selection.Font.Bold = True
    Range("S9:Y9").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("S11:Y11").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("S13:Y13").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("S15:Y15").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("S17:Y17").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("S19:Y19").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("S21:Y21").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("S22:Y23").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10498160
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("X8:Y23").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    
    Range("N1").Select
Range("S3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-18],""?-02-*"")+COUNTIF(C[-18],""?-03-*"")+COUNTIF(C[-18],""?-04-*"")+ _
COUNTIF(C[-18],""?-05-*"")+COUNTIF(C[-18],""?-06-*"")"
    Range("T3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-15],""?-02-*"")+COUNTIF(C[-15],""?-03-*"")+COUNTIF(C[-15],""?-04-*"")+ _
COUNTIF(C[-15],""?-05-*"")+COUNTIF(C[-15],""?-06-*"")"
    Range("V3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-21],""?-10-*"")+COUNTIF(C[-21],""?-11-*"")+COUNTIF(C[-21],""?-12-*"")+ _
COUNTIF(C[-21],""?-13-*"")+COUNTIF(C[-21],""?-14-*"")+COUNTIF(C[-21],""?-15-*"")"
    Range("W3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-18],""?-10-*"")+COUNTIF(C[-18],""?-11-*"")+COUNTIF(C[-18],""?-12-*"")+ _
COUNTIF(C[-18],""?-13-*"")+COUNTIF(C[-18],""?-14-*"")+COUNTIF(C[-18],""?-15-*"")"
    Range("X3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-15],""?-12-*"")+COUNTIF(C[-15],""?-14-*"")"
    Range("Y3").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-24],""?-20-*"")"
    Range("Z3").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-21],""?-20-*"")"
    Range("AB3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-27],""?-30-*"")+COUNTIF(C[-27],""?-31-*"")+COUNTIF(C[-27],""?-32-*"")+ _
COUNTIF(C[-27],""?-33-*"")+COUNTIF(C[-27],""?-34-*"")+COUNTIF(C[-27],""?-35-*"")+COUNTIF(C[-27],""?-36-*"")+COUNTIF(C[-27],""?-37-*"")"
    Range("AC3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-24],""?-30-*"")+COUNTIF(C[-24],""?-31-*"")+COUNTIF(C[-24],""?-32-*"")+ _
COUNTIF(C[-24],""?-33-*"")+COUNTIF(C[-24],""?-34-*"")+COUNTIF(C[-24],""?-35-*"")+COUNTIF(C[-24],""?-36-*"")+COUNTIF(C[-24],""?-37-*"")"
    Range("AE3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-30],""?-40-*"")+COUNTIF(C[-30],""?-41-*"")+COUNTIF(C[-30],""?-42-*"")+ _
COUNTIF(C[-30],""?-43-*"")+COUNTIF(C[-30],""?-44-*"")+COUNTIF(C[-30],""?-45-*"")+COUNTIF(C[-30],""?-46-*"")"
    Range("AF3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-27],""?-40-*"")+COUNTIF(C[-27],""?-41-*"")+COUNTIF(C[-27],""?-42-*"")+ _
COUNTIF(C[-27],""?-43-*"")+COUNTIF(C[-27],""?-44-*"")+COUNTIF(C[-27],""?-45-*"")+COUNTIF(C[-27],""?-46-*"")"
    Range("AG3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-24],""?-44-*"")+COUNTIF(C[-24],""?-46-*"")"
    Range("AH3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-33],""?-50-*"")+COUNTIF(C[-33],""?-51-*"")+COUNTIF(C[-33],""?-52-*"")+ _
COUNTIF(C[-33],""?-53-*"")"
    Range("AI3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-30],""?-50-*"")+COUNTIF(C[-30],""?-51-*"")+COUNTIF(C[-30],""?-52-*"")+ _
COUNTIF(C[-30],""?-53-*"")+COUNTIF(C[-30],""?-51-*"")"
    Range("AJ3").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-27],""?-53-*"")"
    Range("AK3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-36],""?-60-*"")+COUNTIF(C[-36],""?-61-*"")+COUNTIF(C[-36],""?-62-*"")+ _
COUNTIF(C[-36],""?-63-*"")+COUNTIF(C[-36],""?-64-*"")+COUNTIF(C[-36],""?-65-*"")+COUNTIF(C[-36],""?-66-*"")+COUNTIF(C[-36],""?-67-*"")+COUNTIF(C[-36],""?-68-*"")+COUNTIF(C[-36],""?-69-*"")"
    Range("AL3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-33],""?-60-*"")+COUNTIF(C[-33],""?-61-*"")+COUNTIF(C[-33],""?-62-*"")+ _
COUNTIF(C[-33],""?-63-*"")+COUNTIF(C[-33],""?-64-*"")+COUNTIF(C[-33],""?-65-*"")+COUNTIF(C[-33],""?-66-*"")+COUNTIF(C[-33],""?-67-*"")+COUNTIF(C[-33],""?-68-*"")+COUNTIF(C[-33],""?-69-*"")"
    Range("AM3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-30],""?-61-*"")+COUNTIF(C[-30],""?-62-*"")+COUNTIF(C[-30],""?-63-*"")+ _
COUNTIF(C[-30],""?-64-*"")+COUNTIF(C[-30],""?-65-*"")+COUNTIF(C[-30],""?-66-*"")+COUNTIF(C[-30],""?-67-*"")+COUNTIF(C[-30],""?-68-*"")+COUNTIF(C[-30],""?-69-*"")"
    Range("AO3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-36],""?-70-*"")+COUNTIF(C[-36],""?-71-*"")+COUNTIF(C[-36],""?-72-*"")+ _
COUNTIF(C[-36],""?-73-*"")+COUNTIF(C[-36],""?-74-*"")"
    Range("AP3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-33],""?-70-*"")+COUNTIF(C[-33],""?-71-*"")+COUNTIF(C[-33],""?-72-*"")+ _
COUNTIF(C[-33],""?-73-*"")+COUNTIF(C[-33],""?-74-*"")"
    Range("AQ3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-42],""?-80-*"")+COUNTIF(C[-42],""?-81-*"")"
    Range("AR3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-39],""?-80-*"")+COUNTIF(C[-39],""?-81-*"")"
    Range("AT3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-45],""5-01-*"")+COUNTIF(C[-45],""5-02-*"")+COUNTIF(C[-45],""5-03-*"")"
    Range("AU3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-42],""5-01-*"")+COUNTIF(C[-42],""5-02-*"")+COUNTIF(C[-42],""5-03-*"")"
    Range("AV3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-39],""5-01-*"")+COUNTIF(C[-39],""5-02-*"")+COUNTIF(C[-39],""5-03-*"")"
    Range("S3:AV3").Select
    Selection.NumberFormat = "0"
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("X8:Y8").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-12-*"")"
    Range("X9:Y9").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-14-*"")"
    Range("X10:Y10").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-14-*"")"
    Range("X11:Y11").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-46-*"")"
    Range("X12:Y12").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-53-*"")"
    Range("X13:Y13").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-61-*"")"
    Range("X14:Y14").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-62-*"")"
    Range("X15:Y15").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-64-*"")"
    Range("X16:Y16").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-66-*"")"
    Range("X17:Y17").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-67-*"")"
    Range("X18:Y18").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-69-*"")"
    Range("X19:Y19").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-70-*"")"
    Range("X20:Y20").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-72-*"")"
    Range("X21:Y21").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-74-*"")"
    Range("X22:Y22").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""5-01-*"")"
    Range("X23:Y23").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""5-02-*"")"
    Range("X24:Y24").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("X8:Y24").Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    Range("X8:Y24").Select
    Range("X24").Activate
    ActiveCell.FormulaR1C1 = "=SUM(R[-16]C:R[-1]C)"
    Range("X8:Y24").Select
    Range("Y8").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y9").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y10").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y11").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y12").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y13").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y14").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y15").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y16").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y17").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y18").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y19").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y20").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y21").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y22").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y23").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("X8:Y24").Select
    Range("Y24").Activate
    Range("X24:Y24").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("S3:AW3").Select
    Range("AW3").Activate
    ActiveCell.FormulaR1C1 = "=SUM(RC[-30]:RC[-1])"
    Range("S3:AW3").Select
    ActiveWindow.SmallScroll ToRight:=2
    Range("AX9").Select
    Columns("AW:AW").ColumnWidth = 8
    Columns("AW:AW").ColumnWidth = 6.43
    Range("AW3").Select
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("AW3").Select
    Selection.ClearContents
    Range("AW2").Select
    ActiveCell.FormulaR1C1 = "C2"
    Range("AT2:AV2").Select
    Selection.AutoFill Destination:=Range("AT2:AY2"), Type:=xlFillDefault
    Range("AT2:AY2").Select
    Columns("AW:AY").Select
    Selection.ColumnWidth = 8.14
    Range("AW1:AY1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "Kontrolle Auswertung"
    Range("AW1:AY1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Range("AW1:AY3").Select
    Range("AW3").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("AW3:AY3").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AW2").Select
    ActiveCell.FormulaR1C1 = "C2"
    Range("AW3").Select
    ActiveCell.FormulaR1C1 = _
        "=RC[-30]+RC[-27]+RC[-24]+RC[-21]+RC[-18]+RC[-15]+RC[-12]+RC[-9]+RC[-6]"
    Range("AX3").Select
    ActiveCell.FormulaR1C1 = _
        "=RC[-30]+RC[-27]+RC[-24]+RC[-21]+RC[-18]+RC[-15]+RC[-12]+RC[-9]+RC[-6]+RC[-3]"
    Range("AY3").Select
    ActiveCell.FormulaR1C1 = _
        "=RC[-30]+RC[-27]+RC[-24]+RC[-21]+RC[-18]+RC[-15]+RC[-12]+RC[-9]+RC[-6]"
    Range("AW3:AY3").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = False
    Selection.Font.Bold = True
     ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    Range("AO3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-36],""?-70-*"")+COUNTIF(C[-36],""?-71-*"")+COUNTIF(C[-36],""?-72-*"")+ _
COUNTIF(C[-36],""?-73-*"")+COUNTIF(C[-36],""?-74-*"")"
    Range("AN3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-39],""?-70-*"")+COUNTIF(C[-39],""?-71-*"")+COUNTIF(C[-39],""?-72-*"")+ _
COUNTIF(C[-39],""?-73-*"")+COUNTIF(C[-39],""?-74-*"")"
    Range("AI3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIF(C[-30],""?-50-*"")+COUNTIF(C[-30],""?-51-*"")+COUNTIF(C[-30],""?-52-*"")+ _
COUNTIF(C[-30],""?-53-*"")"
    
    Range("X8:Y8").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-12-*"")"
    Range("X8:Y8").Select
    Selection.AutoFill Destination:=Range("X8:Y23"), Type:=xlFillDefault
    Range("X8:Y23").Select
    Range("X9:Y9").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-14-*"")"
    Range("X10:Y10").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-44-*"")"
    Range("X11:Y11").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-46-*"")"
    Range("X12:Y12").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-53-*"")"
    Range("X13:Y13").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-61-*"")"
    Range("X14:Y14").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-62-*"")"
    Range("X15:Y15").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-64-*"")"
    Range("X16:Y16").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-66-*"")"
    Range("X17:Y17").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-67-*"")"
    Range("X18:Y18").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-69-*"")"
    Range("X19:Y19").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-70-*"")"
    Range("X20:Y20").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-72-*"")"
    Range("X21:Y21").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-74-*"")"
    Range("X22:Y22").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""5-01-*"")"
    Range("X23:Y23").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""5-03-*"")"
    Columns("S:AY").Select
    Range("S2").Activate
    Selection.EntireColumn.Hidden = True
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
        Range("K3").Select
    ActiveCell.FormulaR1C1 = "Maße in cm"
    Range("L3").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    Range("K4").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'Maße Rollregal'!C1:C2,2,FALSE)"
    Range("K4").Select
    Selection.AutoFill Destination:=Range("K4:K2000"), Type:=xlFillDefault
        Range("I3:L1012").Select
    ActiveWorkbook.Worksheets("Auswertung").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Auswertung").Sort.SortFields.Add Key:=Range( _
        "I4:I1012"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Auswertung").Sort
        .SetRange Range("I3:L1012")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
      Columns("K:K").Select
    Range("K3").Activate
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    Range("N1").Select
        Columns("I:J").Select
    Range("I3").Activate
    Selection.Font.Bold = False
    Range("J15").Select
Range("I1:K2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("E1:F2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("A1:B2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.ColumnWidth = 5.57
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Gang"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "Gang"
    Range("H7").Select
    Columns("F:F").ColumnWidth = 4.57
    Range("K3").Select
    ActiveCell.FormulaR1C1 = "Gang"
    Range("L4").Select
    Columns("K:K").ColumnWidth = 8.29
    Range("M9").Select
 Range("K1:N2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Selection.Font.Bold = True
    Range("F1:H2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A1:C2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("B4").Select
    Columns("K:K").ColumnWidth = 8.43
    Columns("F:F").ColumnWidth = 8.43
    Columns("A:A").ColumnWidth = 8.43
    Columns("A:D").Select
    Range("A3").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Columns("F:I").Select
    Range("F3").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Columns("K:O").Select
    Range("K3").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("Q10").Select
Columns("K:K").Select
    Range("K3").Activate
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("K:K").Select
    Range("K3").Activate
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("K3").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("F:F").Select
    Range("F3").Activate
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("F3").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("A:A").Select
    Range("A3").Activate
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("A3").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("C7").Select
 Columns("L:M").Select
    Range("L3").Activate
    Selection.Font.Bold = False
    Range("K4").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[1],3,2)"
    Range("K4").Select
    Selection.AutoFill Destination:=Range("K4:K2000"), Type:=xlFillDefault
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[1],3,2)"
    Range("F4").Select
    Selection.AutoFill Destination:=Range("F4:F2000"), Type:=xlFillDefault
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[1],3,2)"
    Range("A4").Select
    Selection.AutoFill Destination:=Range("A4:A2000"), Type:=xlFillDefault
    Range("B5").Select
        Range("K1:N2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("F1:H2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("N:N").Select
    Range("N3").Activate
    Selection.Font.Bold = True
    Range("N11").Select
    Range("K1:N2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Columns("L:M").Select
    Selection.Font.Bold = False
    Range("K1:N2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("L3:M3").Select
    Selection.Font.Bold = True
    Range("L6").Select
    '
    Columns("P:P").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Columns("J:J").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("A3:O3").Select
    Range("O3").Activate
    Selection.AutoFilter
    Range("O9").Select
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("B:B").ColumnWidth = 12.71
    Columns("B:B").ColumnWidth = 13.71
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("L:L").EntireColumn.AutoFit
    Columns("M:M").EntireColumn.AutoFit
    Columns("N:N").EntireColumn.AutoFit
End Sub
Sub freieLagerplätzeAufteilen()
Dim SpalteZiel As Long
 Dim Zelle1 As Range
Dim Zelle2 As Range
SpalteZiel = 1
With Sheets("WH25")
 .Range("A:B").Sort key1:=.Cells(1, 2), order1:=xlDescending, Header:=xlYes
Set Zelle2 = .Cells(1, 2)
Do
 Set Zelle1 = Zelle2.Offset(1, 0)
 If Zelle1.Value = "" Then Exit Sub
 Set Zelle2 = .Columns(2).Find(What:=Zelle1.Value, searchdirection:=xlPrevious)
With Sheets("Auswertung")
 .Cells(1, SpalteZiel).Value = Zelle1.Value
 .Cells(3, SpalteZiel).Resize(1, 2).Value = Zelle1.Worksheet.Range("A1:B1").Value
 Range(Zelle1.Offset(0, -1), Zelle2).Copy Destination:=.Cells(4, SpalteZiel)
 End With
SpalteZiel = SpalteZiel + 3
Loop
End With
 End Sub
Danke Dir
Michl

Bild

Betrifft: AW: Daniel, du hast Recht...Leider bin ich zu DOOF :-(
von: matthias
Geschrieben am: 30.09.2015 12:31:17
Hallo Michl,
ich werd mal drüber schaun, wird aber heut nichts mehr. Ich meld mich dann nochmal.
lg Matthias

Bild

Betrifft: AW: Daniel, du hast Recht...Leider bin ich zu DOOF :-(
von: Daniel
Geschrieben am: 30.09.2015 13:10:35
Hi
wenn du Code hier einstellst, damit wir uns das anschauen und die Fehler für dich suchen, dann solltest du den Code vorher noch ein bisschen überarbeiten und alles überflüssige und nicht benötigte entfernen.
- Lösche alle Zeilen mit .ScrollColumn oder .ScrollRow
- lösche alle "...Select / Selection..." bzw "...Select / ActiveCell..."
dh aus

Range("AW2").Select
     ActiveCell.FormulaR1C1 = "C2"

wird
Range("AW2").FormulaR1C1 = "C2"
aus

Columns("I:I").Select
     Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

wird
Columns("I:I").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
- Lösche in den Zeilen mit Formatierungsbefehlen alle nicht benötigten raus und lasse nur die stehen, die du tatsächlich verändern willst.
Der Code wird dann nicht nur kürzer und schneller, sondern auch übersichlicher und vielleicht findest du deinen Fehler dann selber.
Gruß Daniel

Bild

Betrifft: AW: Daniel, du hast Recht...Leider bin ich zu DOOF :-(
von: matthias
Geschrieben am: 30.09.2015 17:58:03
Hallo Michl,
kannst du mir eine kurze Beschreibung zu den Makros geben, was eigentlich getan werden soll? Eventuell kann man da einen kürzeren Weg finden, gerade bei 6 und 7.
Nach kurzem Überfliegen bin ich soweit, dass ich sagen kann:

  • freieLagerplätze1: doppelte Einträge Spalte A finden und löschen (ersten Datensatz behalten), die Frage ist nur: In welcher Tabelle soll dies geschehen? In deinem Hauptmakro wird zunächst "Auswertung" angewählt, aber ein neu erstelltes TB ist eh leer, von daher sicher nicht das Ziel.
  • freieLagerplätze2: bestimmte Ausdrücke ersetzen (TB "RBumwandeln"), hier ist alles klar
  • freieLagerplätze3: Prüfen ob Zelle im TB "WH25" Spalte A bereits im TB "GD65" Spalte A vorhanden ist, falls ja Zeile löschen
  • freieLagerplätze4: Prüfen ob Zelle im TB "WH25" Spalte A bereits im TB "belegte Lagerplätze" Spalte A vorhanden ist, falls ja Zeile löschen
  • freieLagerplätze6: Anlegen der Auswertetabelle; kann man nicht eine Vorlage kopieren, statt wertvolle Sekunden damit zu verbringen alle Zellen zu färben, umranden usw.?
  • freieLagerplätze7: gilt gleiches wie für freieLagerplätze6
  • freieLagerplätzeAufteilen: Du sortierst deine Einträge nach Feldtypen, teilst deine Lagerplätze in Feldtypen auf und kopierst diese in die Auswertung.

  • Falls ich etwas falsch aufgefasst haben sollte, korrigiere mich bitte.
    Zum Thema Auswertung wäre es günstiger ein Tabellenblatt "Auswertung_Vorlage" was bereits perfekt aussieht händig zu erstellen und dann mit dem Makro zu kopieren und in "Auswertung" umzunennen. Das dauert nur einen Sekundenbruchteil und bedarf 2 Zeilen Code. Dein Makro "freieLagerplätzeAufteilen" müsste man dann nur dahingehend ändern, dass es beim kopieren den Feldtyp erfasst und in die richtige Spalte kopiert (statt wie jetzt die erste Spalte zu nehmen und bei jedem Typ 3 Spalten weiter zu rücken), sowie deine Formel für den Gang einfügt.
    Kurze Frage: Was soll eigentlich mit einem vierten/fünften usw. Feldtypen passieren oder gibt es die nicht? Momentan sieht es ja so aus, dass alle Feldtypen in die Auswertung kopiert werden, aber der vierte wird komplett gelöscht, ein fünfter wird mit deiner Auswertung teilweise überschrieben.
    Zudem sind die Feldtypen in der Auswertung eh sortiert, ist die Spalte Feldtyp bei allen dreien denn dann noch notwendig? Steht doch eh immer das gleiche drinn, von daher überflüssige Daten, richtig?
    lg Matthias

    Bild

    Betrifft: Danke Daniel für deine Tipppppps :-)
    von: Michl
    Geschrieben am: 01.10.2015 01:03:22
    Hallo Matthias,
    danke ersteinmal für deine wertvolle Zeit und deine Hile :-)
    Ich wewrde die Dateien zu mir nach Hause Mailen. Ich hoffe, das ich es dann hier Hochladen kann.
    Somit hast du Alle TXT Dateien und die Excel Datei.
    Frage1:
    Nach kurzem Überfliegen bin ich soweit, dass ich sagen kann:
    •freieLagerplätze1: doppelte Einträge Spalte A finden und löschen (ersten Datensatz behalten), die Frage ist nur: In welcher Tabelle soll dies geschehen? In deinem Hauptmakro wird zunächst "Auswertung" angewählt, aber ein neu erstelltes TB ist eh leer, von daher sicher nicht das Ziel.

    Dies geschieht in der TB WH25
    Frage2:
    Kurze Frage: Was soll eigentlich mit einem vierten/fünften usw. Feldtypen passieren oder gibt es die nicht? Momentan sieht es ja so aus, dass alle Feldtypen in die Auswertung kopiert werden, aber der vierte wird komplett gelöscht, ein fünfter wird mit deiner Auswertung teilweise überschrieben.

    Zudem sind die Feldtypen in der Auswertung eh sortiert, ist die Spalte Feldtyp bei allen dreien denn dann noch notwendig? Steht doch eh immer das gleiche drinn, von daher überflüssige Daten, richtig?

    Ich glaube durch die Datein wirst du schlauer :-)
    Nocheinmal Besten Dank, weiß gar nicht, wie ich das wieder gut machen kann.
    Liebe Grüße Michl

    Bild

    Betrifft: AW: Danke Daniel für deine Tipppppps :-)
    von: Michl
    Geschrieben am: 01.10.2015 15:48:13
    Hallo:-)
    anbei die Dateien:
    die erste Datei heißt :Anzahl freie Lagerplätze NEU:
    https://www.herber.de/bbs/user/100531.xlsm
    Ich mußte die Datei kleiner machen
    TB gd65 hat ca. 20000 Zeilen.
    Jetzt die TXT Dateien:
    freie Lagerplätze GD65 die mußte ich auch kleiner machen max 300KB
    https://www.herber.de/bbs/user/100532.txt
    freie Lagerplätze WH25:
    https://www.herber.de/bbs/user/100533.txt
    Ich hoffe , das du dadurch einen Besseren Überblick bekommst.
    Danke MICHL

     Bild

    Beiträge aus den Excel-Beispielen zum Thema "Betätigung eines Makrobuttons während man noch Zel"