Inhalt Tabelle in versch. Sheets kopiere
13.03.2021 22:31:47
Melpomene
Ich habe eine Tabelle, die ist unten angehängt.
In der Tabelle sind Artikel, die bestimmten Bereichen zugehören.
Für jeden Bereich muss ein einzelnes Tabellenblatt angelegt werden und alle Inhalte, die in diesem Bereich sind eingefügt werden.
Ich habe es geschafft alleine (mit google-Suche natürich, aber mit selbstständiger Anpassung so weit zu kommen:
Sub FuegeFürJedenBereichEinSheetEin()
Range("C1").Select
Application.CutCopyMode = False
Columns("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"G2"), Unique:=True
Dim Bereich As String
Dim Zelle As Range
Dim Tabelle As Worksheet
Bereich = "G2:G10"
With ActiveWorkbook
For Each Zelle In ActiveSheet.Range(Bereich).Cells
Set Tabelle = .Sheets.Add(After:=.Sheets(Sheets.Count))
Tabelle.Name = Zelle.Text
Next Zelle
End With
End Sub
Hier bekomme ich in der Zeile "Tabelle.Name = Zelle.Text immer eine Fehlermeldung, aber die Sheets werden trotzdem erstellt.
Ich hätte gerne eine allgemeingültige Formel mit variablem Bereich - ich hab als Bereich G2:G10 eingegeben aber es kann auch mal G2:G5 oder G2:G15 sein. Kommt vielleicht daher die Fehlermeldung? Weil in einigen Zellen gar nichts drin steht?
Nun möchte ich in die entstandenen Sheets die entsprechenden Zellen eintragen. MIT der ersten Zeile - also den Namen der Spalten - und daran scheitere ich. Mit dem Makrorecorder, kann ich das zwar machen, aber auch nur mit bestimmten Sheets - also z.B. Filter setzten auf "A" und dann alles rüber kopieren. Aber ich habe insgesamt 400 Bereiche, von denen bei der Abfrage immer zwischen 5 - 25 Bereiche vorkommen.
Ich brauche also ein allgemeingültiges Makro:
"Wenn ein Sheet mit dem Titel "A" vorkommt, so kopiere alle Zeilen von Spalte A - D in denen in Spalte C "A" steht UND auch den Titel der Spalten (Zeile 1)."
"Wenn ein Sheet mit dem Titel "XY" vorkommt, so kopiere alle Zeilen von Spalte A - D in denen in Spalte C "XY" steht UND auch den Titel der Spalten (Zeile 1)"
https://www.herber.de/bbs/user/144750.xlsx
Vielen Dank für eure Hilfe
Liebe Grüße
Melpomene
