Ich bin auf der suche nach einer VBA-Programierung die mein nachstehendes Problem lösen kann.
Ich habe in einer Berechnungstabelle eine Spalte (A) mit beliebig viele, unterschiedlichen Bezeichnungen. Diese sieht wie folgt aus:
A B C G
10 Büro 6 Hans 300
11 Hotel 2 Werner 400
12 Hotel 3 Marco 100
13 Lager 4 Thomas 200
20 Büro 3 Thomas 200
21 Lager 1 Thomas 300
22 Lager 4 Thomas 100
Zwischen den Spalten C und G, gibt es Leer Spalten zur besseren Übersicht. So auch zwischen den Zeilen 13-20. Nun möchte ich mir die Bezeichnung unter A mit den zugehörigen Werten in den Zeilen in ein neues Tabellenblatt schreiben lassen. Ideal wäre es, wenn das alles automatisch passiert, wobei zu berücksichtigen ist, das die Bezeichnungen unter A variieren können. Es müsste also auch ein Verweis auf einen Bereich geben, indem die Bezeichnung zuvor definiert werden. Die neuen Tabellen sollten wie folgt aussehen und sortiert sein:
Tabellenblatt 1
A B C G
10 Büro 6 Hans 300
11 Büro 3 Thomas 200
Tabellenblatt 2
A B C G
10 Hotel 2 Werner 400
11 Hotel 3 Marco 100
Tabellenblatt 3
A B C G
10 Lager 4 Thomas 200
11 Lager 1 Thomas 300
12 Lager 4 Thomas 100
Die Daten sollen untereinander aufgelistet werden. Leider kenne ich mich mit VBA bislang gar nicht aus und hoffe hier auf Hilfe.
Hallo,
hast Du einmal versucht, nur auf einem Blatt die Werte einzutragen und Dich in den anderen Blättern mit Zellbezügen auf dieses „StammDatenBlatt“ zu beziehen? Du kannst im Prinzip dann auf die Abbilder Filter und Sortierungen anwenden.
Um das zu automatisieren wäre VBA eine Hilfe, aber vielleicht geht es ja auch ohne.
Freundliche Grüße
Thomas
Es müsste also auch ein Verweis auf einen
Bereich geben, indem die Bezeichnung zuvor definiert werden.
das habe ich nicht ausreichend verstanden *glaub*
Alt+F11, Einfügen Modul nachstehenden Code reinkopieren, ggfs den Blattnamen tabelle1 anpassen, Editor schließen.
In Excel Alt+F8 und das makro Aufteilen ausführen lassen.
Gruß
Reinhard
Option Explicit
Sub Aufteilen()
Dim Zei1 As Long, Zei2 As Long, wks1 As Worksheet, dummy As String
Set wks1 = Worksheets("Tabelle1")
On Error Resume Next
For Zei1 = 10 To wks1.Cells(Rows.Count, 1).End(xlUp).Row
If wks1.Cells(Zei1, 1).Value "" Then
dummy = Worksheets(wks1.Cells(Zei1, 1).Value).Name
If Err.Number 0 Then
Err.Clear
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = wks1.Cells(Zei1, 1).Value
End If
With Worksheets(wks1.Cells(Zei1, 1).Value)
Zei2 = Application.Max(.Cells(Rows.Count, 1).End(xlUp).Row, 9) + 1
wks1.Range("A" & Zei1 & ":G" & Zei1).Copy .Cells(Zei2, 1)
End With
End If
Next Zei1
End Sub