Automatisierung mit Hilfe VBA

Hallo liebe Excel Gemeinde,
Möchte gerne mit Hilfe Makro folgendes Problem lösen; täglich bekomme ich einige Berichte nach Excel exportiert die ich dementsprechend bearbeiten muss um ein gezieltes Ergebnis zu haben. Es handelte sich um ein paar hunderte von Zeilen pro Excel Bericht.
Von Zeilen A1 bis D8 sind Kopf Zeilen. Variable Daten Berichten sind von A8:D.250 oder 388 oder 423 (von A8:Aohne leere Zeilen). Daten von B8:C. haben zwischen jeden Mitarbeiter eine Leere Zeile. Daten von "E8:E..." haben auch keine leere Zeilen. Habe eine Beispiel Mappe mit 2 Tabellen Blätter. Tabellen Blatt Vorher es handelt sich hier um originalen Export Bericht und Tabelle Nachher ist eine Beispiels Datei wie es aussehen sollte.
https://www.herber.de/bbs/user/78808.xls
Mein selbst aufgezeichnetes Makro:


Sub Makro1()
' Makro1 Makro
' test
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Selection.ColumnWidth = 37.57
Range("B8").Select
Selection.Cut
Range("A9").Select
ActiveSheet.Paste
Selection.AutoFill Destination:=Range("A9:A12"), Type:=xlFillDefault
Range("A9:A12").Select
Range("B13").Select
Selection.Cut
Range("A14").Select
ActiveSheet.Paste
Selection.AutoFill Destination:=Range("A14:A18"), Type:=xlFillDefault
Range("A14:A18").Select
Range("B19").Select
Selection.Cut
Range("A20").Select
ActiveSheet.Paste
Selection.AutoFill Destination:=Range("A20:A23"), Type:=xlFillDefault
Range("A20:A23").Select
Range("B24").Select
Selection.Cut
Range("A25").Select
ActiveSheet.Paste
Selection.AutoFill Destination:=Range("A25:A28"), Type:=xlFillDefault
Range("A25:A28").Select
Range("B29").Select
Selection.Cut
Range("A30").Select
ActiveSheet.Paste
Selection.AutoFill Destination:=Range("A30:A33"), Type:=xlFillDefault
Range("A30:A33").Select
Range("B34").Select
Selection.Cut
ActiveWindow.SmallScroll Down:=9
Range("A35").Select
ActiveSheet.Paste
Selection.AutoFill Destination:=Range("A35:A39"), Type:=xlFillDefault
Range("A35:A39").Select
Range("B40").Select
Selection.Cut
Range("A41").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=6
Selection.AutoFill Destination:=Range("A41:A43"), Type:=xlFillDefault
Range("A41:A43").Select
'....usw. von  zum ersten "E" leeren Spalten....
End Sub

So wie kann man Makro automatisieren(bezogen auf Blatt Nachher):
-wenn ich Makro starte (in active sheet) er soll zuerst eine Spalte einfügen(Spalte A)
-dann solle er nur die Mitarbeiter Namen (die gibts viele) aus Spalte B nach Spalte A schreiben
-alle Mitarbeiter Namen haben große Buchstaben
-zwischen jeden neuen Mitarbeiter gibt es immer eine leere C Spalte, siehe bitte Tabellen Beispiel Nachher und in Zeilen von E8:E. bis zum letzten gefüllten Zeilen sind immer Daten (Ohne leere Zeilen)
Ich hoffe dass ich mein Anliegen verständlich beschrieben habe.
Vielen Dank für jeder kommende Hilfe
Gruß
Daniel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub format() Dim Name As String Dim maxZeile As Long Dim Sprung As Long maxZeile = Range("B1").SpecialCells(xlCellTypeLastCell).Row ' speichert die letzte belegte _ Zeile in Spalte B Columns(1).Select Selection.Insert Shift:=xlToRight ' fügt eine Spalte vor Spalte A ein Name = Cells(8, 2).Value 'speichert den ersten Namen Cells(8, 2).ClearContents 'löscht den ersten Namen aus Spalte B For a = 9 To maxZeile 'schleifen beginn ( große Schleife ) If Len(Cells(a, 3)) > 0 Then ' beginn kleine schleife) Cells(a, 1).Value = Name Else Name = Cells(a, 2).Value Cells(a, 2).ClearContents 'löscht den Namen aus Spalte B End If 'ende kleine Schleife Next a 'Ende Große Schleife, wenn a = maxZeile Columns("A:A").EntireColumn.AutoFit 'optimale Spaltenbreite für Spalte A Range("A1").Select End Sub

Sub format() Dim Name As String Dim maxZeile As Long Dim Sprung As Long maxZeile = Cells(Rows.Count, 2).End(xlUp).Row ' speichert die letzte belegte Zeile in Spalte B Application.ScreenUpdating = False Columns(1).Select Selection.Insert Shift:=xlToRight ' fügt eine Spalte vor Spalte A ein 'Spaltentitel eintragen in Spalte A Cells(7, 1).Value = Cells(6, 2).Text Name = Cells(8, 2).Value 'speichert den ersten Namen Cells(8, 2).ClearContents 'löscht den ersten Namen aus Spalte B For a = 9 To maxZeile 'schleifen beginn ( große Schleife ) If Len(Cells(a, 3)) > 0 Then ' beginn kleine schleife) Cells(a, 1).Value = Name Else Name = Cells(a, 2).Value Cells(a, 2).ClearContents 'löscht den Namen aus Spalte B End If 'ende kleine Schleife Next a 'Ende Große Schleife, wenn a = maxZeile Columns("A:A").EntireColumn.AutoFit 'optimale Spaltenbreite für Spalte A 'Fenster fixieren ActiveWindow.ScrollRow = 1 Range("A8").Select ActiveWindow.FreezePanes = True 'Autofilterbereich neu setzen With ActiveSheet If .AutoFilterMode = True Then .AutoFilterMode = False End If .Range(.Cells(7, 1), .Cells(maxZeile, 5)).AutoFilter End With Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread