Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1360to1364
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA - Liste auf mehrere Blätter verteilen

VBA - Liste auf mehrere Blätter verteilen
22.05.2014 10:06:13
henrik
Hi zusammen,
ich ziehe mir jeden Monat eine Liste aus unserer Datenbank.
Hier ein Auszug der Liste. Im Original ist sie bedeutend länger.
https://www.herber.de/bbs/user/90783.xlsx
In Spalte D steht immer die store_id (insg. ca 90 werden aber zukünftig mehr). Excel soll jetzt für jede store_id ein eigenes Tabellenblatt anlegen und die Liste genau wie in der ursprungsform (also mit den gleichen Spalten) aber jeweils nur die Zeilen mit der entsprechenden store_id auf diese Tabellenblätter verteilen. Idealerweise in aufsteigender Reihenfolge, 1-2-3 usw. Ist aber nicht sooo wichtig falls das zu kompliziert ist.
Anschließend soll für jedes der Tabellenblätter folgender Code ausgeführt werden, der jedes Tabellenblatt formatiert.
Sub GAForm()
Rows(1).ClearContents
With Cells(3, 2).CurrentRegion
With .Offset(-1, 0).Resize(.Rows.Count + 2)
.Cells(1, 1).Value = 1
.Cells(1, 1).Copy
.SpecialCells(xlCellTypeConstants, 2).PasteSpecial xlPasteValues, operation:=xlMultiply
.Rows(1).Value = Array("Datum", "Code", "Wert")
.Columns(1).NumberFormat = "DD.MM.YYYY hh:mm"
.Cells(.Rows.Count, 1).Value = "Summe"
.Cells(.Rows.Count, 3).FormulaR1C1 = "=Sum(R[-" & .Rows.Count - 2 & "]C:R[-1]C)"
.BorderAround Weight:=xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Rows(1).Font.Bold = True
.Rows(.Rows.Count).Font.Bold = True
.Cut Destination:=Cells(5, 1)
Columns("A:A").EntireColumn.AutoFit
ActiveWindow.DisplayGridlines = False
Columns("B:B").EntireColumn.AutoFit
Range("C6").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "#,##0.00 $"
Rows("4:4").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End With
End With
End Sub

Kann mir da jemand helfen? Wäre genial!
BG
Henrik

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

Betreff
Datum
Anwender
Anzeige
AW: Doppelt
22.05.2014 10:45:09
Henry
Mit dem tabellenblätterm könnte man so erstellen:
Sub Blaetter_nach_Spalte_D()
Dim Sheet1 As Worksheet
Dim sheetnew As Worksheet
Dim Blattname As String
Dim i As Integer
Dim LetzteZeile As Integer
Set Sheet1 = ThisWorkbook.Worksheets(1)
LetzteZeile = Sheet1.Cells(Rows.Count, 4).End(xlUp).Row
Blattname = Sheet1.Name
For i = 1 To LetzteZeile
If Sheet1.Cells(i, 4).Value  "" Then
Set sheetnew = Worksheets.Add(After:=Sheets(Blattname))
With sheetnew
.Name = Sheet1.Range("D" & i) 'Tabellenname
End With
Blattname = sheetnew.Name
End If
Next
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige