Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1852to1856
1852to1856
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Tabellenblätter zusammenfassen

Forumthread: Tabellenblätter zusammenfassen

Tabellenblätter zusammenfassen
27.10.2021 10:59:42
Fabian
Guten Morgen in die Runde,
ich habe in einer Arbeitsmappe mehrere Tabellenblätter. Immer unterschiedlich in der Anzahl.
Die Namen der Blätter sind z.b. M13659, M13648, M2854,M285,M654,M65, Lolly, Brot
Tabellenblätter, die die ersten 3 Stellen gleich haben, sollen in einem neuen Tabellenblatt zusammengefasst werden.
Z.B.
M13659 + M13648 ins neue Blatt M13. Die Blätter M13659 + M13648 dann löschen.
Könnt ihr mir da bitte helfen.
Lieben Dank
Gruß Fabi
Anzeige

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellenblätter zusammenfassen
27.10.2021 11:21:48
Klaus
Hi Fabi,
Fangen die Blattnamen immer mit M an, oder soll auch "Lolly" und "Lollypop" in einem neuem Blatt "Lol" zusammen gefasst werden?
M65 gibt es schon, wie solen M654 und M65 zusammen gefasst werden? Ein neues Blatt M65 darf ja nicht angelegt werden.
Wie viele Blätter sind es, und wie oft brauchst du das? Bei 10 Blättern und nur einmal würd ich das manuell machen, wenn die Aufgabe häufig vorkommt macht es natürlich Sinn ein Programm zu schreiben.
Sind in den Blättern nur Texte, oder gibt es auch Formeln mit Verknüpfungen? Kann das löschen von Blättern also zu #BEZUG Fehlern führen? Oder können eventuelle Formeln als Text eingefügt werden?
LG,
Klaus M.
Anzeige
AW: Tabellenblätter zusammenfassen
27.10.2021 11:30:05
Fabian
Hallo Klaus,
gute Fragen :-)
Lolly und Lollypop bleiben so erhalten
M654 und M65 in M65 zusammenfassen
Ja, die Blätter haben immer das M vorne
Nein, es gibt keine Formeln oder verknüpfungen etc..
Wenn M1234 und M1235 In M12 zusammengefasst werden, sind es nur die Daten der jeweiligen Blätter. Alles untereinander in das Neue Blatt
Es sind so gut 30-40 Blätter 2-3 mal die Woche
Gruß Fabi
Anzeige
AW: Tabellenblätter zusammenfassen
27.10.2021 12:39:19
UweD
Hallo
so?

Sub yxcv()
Dim TB As Worksheet, TT3 As String, TBZ As Worksheet
Dim LRZ As Long, LR As Long
For Each TB In ThisWorkbook.Sheets
TT3 = Left(TB.Name, 3)
If Left(TT3, 1) = "M" Then
If IsError(Evaluate(TT3 & "!A1")) Then
'Blatt Mxx nicht vorhanden, dann umbenennen
TB.Name = TT3
Else
If TB.Name  TT3 Then
'nur wenn Blatt nicht Zielblatt Mxx
Set TBZ = Sheets(TT3)
LRZ = TBZ.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes
LR = TB.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes
'unten anhängen
TB.Rows(1).Resize(LR).Copy Sheets(TT3).Rows(LRZ + 1).Resize(LR)
'löschen
Application.DisplayAlerts = False
TB.Delete
Application.DisplayAlerts = True
End If
End If
End If
Next
End Sub
LG UweD
Anzeige
AW: Tabellenblätter zusammenfassen
27.10.2021 12:06:37
Rudi
teste mal:

Sub aaa()
Dim objWKS As Object, oOBJ
Dim wks As Worksheet, wksNeu As Worksheet
Set objWKS = CreateObject("scripting.dictionary")
For Each wks In Worksheets
If Len(wks.Name) = 3 Then wks.Name = wks.Name & "_"
objWKS(Left(wks.Name, 3)) = 0
Next
For Each oOBJ In objWKS
Set wksNeu = Worksheets.Add
wksNeu.Name = oOBJ
Next
For Each wks In Worksheets
If Not objWKS.exists(wks.Name) Then
If objWKS(Left(wks.Name, 3)) = 0 Then
wks.Cells(1, 1).CurrentRegion.Copy _
Worksheets(Left(wks.Name, 3)).Cells(1, 1)
objWKS(Left(wks.Name, 3)) = 1
Else
wks.Cells(1, 1).CurrentRegion.Offset(1).Copy _
Worksheets(Left(wks.Name, 3)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
End If
Next wks
Application.DisplayAlerts = False
For Each wks In Worksheets
If Len(wks.Name) > 3 Then wks.Delete
Next
Application.DisplayAlerts = True
End Sub
Gruß
Rudi
Anzeige
AW: Tabellenblätter zusammenfassen
27.10.2021 12:28:58
Klaus 

For Each wks In Worksheets
If Len(wks.Name) > 3 Then wks.Delete
Next
Das killt aber "Lolly" und "Brot" ...
LG,
Klaus M.
AW: Tabellenblätter zusammenfassen
27.10.2021 12:37:02
Rudi
hab nur den ersten Thread gelesen.
Nur M-Blätter:

Sub aaa()
Dim objWKS As Object, oOBJ
Dim wks As Worksheet, wksNeu As Worksheet
Set objWKS = CreateObject("scripting.dictionary")
For Each wks In Worksheets
If Left(wks.Name, 1) = "M" Then
If Len(wks.Name) = 3 Then wks.Name = wks.Name & "_"
objWKS(Left(wks.Name, 3)) = 0
End If
Next wks
For Each oOBJ In objWKS
Set wksNeu = Worksheets.Add
wksNeu.Name = oOBJ
Next
For Each wks In Worksheets
If Left(wks.Name, 1) = "M" Then
If Not objWKS.exists(wks.Name) Then
If objWKS(Left(wks.Name, 3)) = 0 Then
wks.Cells(1, 1).CurrentRegion.Copy _
Worksheets(Left(wks.Name, 3)).Cells(1, 1)
objWKS(Left(wks.Name, 3)) = 1
Else
wks.Cells(1, 1).CurrentRegion.Offset(1).Copy _
Worksheets(Left(wks.Name, 3)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
End If
End If
Next wks
Application.DisplayAlerts = False
For Each wks In Worksheets
If Left(wks.Name, 1) = "M" Then
If Len(wks.Name) > 3 Then wks.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
Gruß
Rudi
Anzeige
AW: Tabellenblätter zusammenfassen
27.10.2021 13:09:47
Fabian
Danke Rudi und Klaus,
ich werde den Code heute Abend testen und eine Rückmeldung geben.
Gruß Fabian
AW: Tabellenblätter zusammenfassen
27.10.2021 14:25:52
UweD
Hallo Rudi
bei deiner Methode werden aber nur zusammenhängende Bereiche kopiert.
Sind Leerzeilen im Blatt fehlt der Rest unterhalb
LG UweD
weiß ich doch
27.10.2021 14:35:52
Rudi
dann muss er das eben anpassen oder noch mal fragen.
Anzeige
AW: Danke Rudi, funktioniert
27.10.2021 19:21:41
Fabian
Hi Rudi,
der Code funktioniert für meine Belange super. Danke dir
Gruß Fabian
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige