Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1448to1452
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

Variable Tabellenblätter verschieben

Variable Tabellenblätter verschieben
06.10.2015 11:10:09
Christina
Hallo zusammen,
ich benötige bitte Hilfe bei folgendem Problem:
Ich erstelle eine Excel-Datei mit diversen Tabellenblättern, die jeweils mit einer dreistelligen Zahl beschriftet sind, bspw. 101,102,103...838,839
Ich möchte nun immer alle Tabellenblätter, die die gleiche Anfangsziffer haben, in eine neue Datei verschieben.
Also - alle mit "1" vorne in eine Datei, alle mit "2" vorne in eine Datei usw.
Mit Sheets(Array(..)).select habe ich es probiert. Aber das funktioniert nicht, weil nicht jeden Monat die gleichen Blätter vorhanden sind - und ich so das Makro jeden Monat doch wieder anfassen musste.
Vielen Dank im Voraus!
Viele Grüße,
Christina

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Eine Möglichkeit...
06.10.2015 13:20:51
Michael
Hallo Christina,
ist bspw. dies hier:
Sub a()
Dim Blatt As Worksheet
Dim ArrNamen() As Variant
Dim Zaehler As Byte
Dim Pre As String
ReDim ArrNamen(1 To Worksheets.Count)
Pre = InputBox("Verschieben von Blättern beginnend mit:", _
"Blätter verschieben")
Select Case True
Case Pre Like "[1-9]"
For Each Blatt In Worksheets
If Left(Blatt.Name, 1) = Pre Then
Zaehler = Zaehler + 1
ArrNamen(Zaehler) = Blatt.Name
End If
Next
Case Else
MsgBox "Nur Ziffern von 1-9 erlaubt. Abbruch!", _
vbInformation, "Falsche Eingabe"
Exit Sub
End Select
ReDim Preserve ArrNamen(1 To Zaehler)
Sheets(ArrNamen).Move
End Sub
LG
Michael

Anzeige
AW: Eine Möglichkeit...
06.10.2015 13:50:18
Christina
Hallo Michael,
danke für den Ansatz - leider stoppt er bei mir beim Punkt "ArrNamen(Zaehler) = Blatt.Name".
Vielleicht liegt es daran, dass ich die einzelnen Tabellenblätter wie folgt erzeugt habe?
' Blatt aufteilen
Dim Zelle1 As Range
Dim Zelle2 As Range
Dim shQuelle As Worksheet
Set shQuelle = ActiveSheet
With shQuelle.UsedRange
.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlYes
Set Zelle1 = .Cells(2, 1)
Do Until Zelle1 = ""
Set Zelle2 = Zelle1.EntireColumn.Find(What:=Zelle1.Value, LookAt:=xlWhole, _
SearchDirection:=xlPrevious)
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Zelle1.Value
.Rows(1).Copy ActiveSheet.Cells(1, 1)
Range(Zelle1, Zelle2).EntireRow.Copy ActiveSheet.Cells(2, 1)
Set Zelle1 = Zelle2.Offset(1, 0)
Loop
End With
Wäre super, wenn Du das mit einbeziehen könntest.
Lieben Dank im Voraus.
Viele Grüße,
Christina

Anzeige
AW: Das kann ich so nicht nachvollziehen...
06.10.2015 14:00:55
Michael
Christina,
denn unabhängig davon, wie Du Deine Tabellenblätter benennst, sammelt mein Code einfach Blattnamen in einem Array, wenn deren erstes Zeichen jenem in der Abfrage (bei mir "Pre") entspricht.
Ich bin von Blattnamen ausgegangen, wie Du sie in Deinem Ausgangsbeitrag angegeben hast: bspw. 101, 102, 103, 504, 838 oder 839.
Hast Du meinen Code einmal autark laufen lassen? Oder hast Du diesen in Deinen Code eingebaut?
Wie gesagt, unter den angegebenen Bedingungen, läuft dies bei mir problemlos (soll heißen: bei Eingabe von zB "1" in der Inputbox werden Tabellenblätter 101, 102, 103... in eine neue Mappe verschoben).
LG
Michael

Anzeige
AW: eine andere Möglichkeit
06.10.2015 13:40:45
Daniel
Hi
probiers mal so:
Sub SheetsNachNameInNeueDateien()
Dim wb(9) As Workbook
Dim sh As Worksheet
Dim i As Long
'--- Blätter in Workbooks aufteilen
For Each sh In ThisWorkbook.Worksheets
If sh.Name Like "###" Then
i = CLng(Left(sh.Name, 1))
If wb(i) Is Nothing Then Set wb(i) = Workbooks.Add(xlWBATWorksheet)
sh.Move after:=wb(i).Worksheets(wb(i).Worksheets.Count)
End If
Next
'--- Workbooks speichren
Application.DisplayAlerts = False
For i = 0 To UBound(wb)
If Not wb(i) Is Nothing Then
wb(i).Sheets(1).Delete
wb(i).SaveAs Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & "-" & i,  _
FileFormat:=xlExcel12
wb(i).Close
End If
Next
Application.DisplayAlerts = True
End Sub
gruß Daniel
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige