Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 12:28:32
Formelfehler aufgrund Einfügen einer Zeile
18.04.2024 11:51:04
Aus Listbox Spalte als Wert zurück bekommen
18.04.2024 11:36:51
Beim Öffnen je nach Datum zu bestimmter Zelle springen
18.04.2024 11:16:38
Pfade werden mit Anführungszeichen "" versehen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1092to1096
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1092to1096
1092to1096
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Excel-Datei automatisch splitten

Excel-Datei automatisch splitten
Klaus
Hallo zusammen,
ich bin sehr auf Eure Hilfe angewiesen.
Meine Exceldatei besteht aus sehr vielen Zeilen und mehreren Spalten.
Gibt es eine Möglichkeit, dass Excel bei jeder Änderung eines Wertes (zB in Spalte A) die entsprechenden Zeilen in eine eXtra Datei kopiert?
Bsp - 3 Spalten:
120 55 Jahre M
120 41 Jahre W
120 40 Jahre W
200 34 Jahre M
800 62 Jahre M
800 20 Jahre W
Excel soll die Dateien in mehrere Dateien (oder zumindest in Tabellenblätter) aufsplitten, sodass:
3 Dateien die jeweils alle Daten für Spalte A mit (120), (200) und (800) separat kopiert.
Vielleicht geht das mit VBA?
Für Tipps bin ich euch 1000 Mal dankbar! :)
Grüße
Klaus

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Excel-Datei automatisch splitten
05.08.2009 14:38:49
Wolli
Hallo Klaus,
so müsste es gehen:
Sub splitten()
Dim shBlatt As Worksheet, lngZeile As Long
Do
lngZeile = 1
Set shBlatt = ActiveSheet
Do
lngZeile = lngZeile + 1
If shBlatt.Cells(lngZeile, 1) = "" Then Exit Sub
Loop Until shBlatt.Cells(lngZeile, 1)  Cells(lngZeile - 1, 1)
Range(shBlatt.Cells(lngZeile, 1), shBlatt.Cells(shBlatt.UsedRange.Rows.Count, _
shBlatt.UsedRange.Columns.Count)).Cut
Set shBlatt = ActiveWorkbook.Sheets.Add(after:=shBlatt)
shBlatt.Paste
Application.CutCopyMode = False
Loop
End Sub
Dieses Tool legt bei jedem Wechsel in Spalte A ein neues Blatt an und kopiert die nachstehenden Daten da hinein.
Gruß, Wolli
Anzeige
AW: Excel-Datei automatisch splitten
05.08.2009 14:47:52
Klaus
Danke Wolli,
du hast es echt drauf!!
Gibts das auch, dass Excel gesonderte Dateien erstellt?
Danke und Gruß
Bitte sehr!
05.08.2009 15:17:41
Wolli 

Sub splitten2()
Dim wbMappe As Workbook, shBlatt As Worksheet, lngZeile As Long
Set shBlatt = ActiveSheet
Do
lngZeile = 1
Do
lngZeile = lngZeile + 1
If shBlatt.Cells(lngZeile, 1) = "" Then Exit Sub
Loop Until shBlatt.Cells(lngZeile, 1)  Cells(lngZeile - 1, 1)
Range(shBlatt.Cells(lngZeile, 1), shBlatt.Cells(shBlatt.UsedRange.Rows.Count, _
shBlatt.UsedRange.Columns.Count)).Cut
Set wbMappe = Workbooks.Add
Set shBlatt = wbMappe.Sheets(1)
wbMappe.Sheets(1).Paste
Application.CutCopyMode = False
Loop
End Sub
Die Mappe stehen dann aber unbenannt und offen in der Gegend rum und müssen noch gespeichert werden. Könnte man auch automatisieren - dann müsstest Du sagen, unter welchem Namen (z.B. mit Hilfe von Zelle A1 zusammenbasteln) und an welchen Ort!
Gruß, Wolli
Anzeige
AW: Bitte sehr!
05.08.2009 15:40:44
Klaus
Hi Wolli,
ein sehr sehr großes Dankeschön an dich! Du hast mir sehr viel Arbeit erspart =)
Wenn du mir jetzt noch sagst wie das funktioniert, dass jede Datei unter dem jeweiligen Namen der Spalte A gespeichert wird an Speicherort X..., dann bist du der Excel King :D
Viele Grüße
:D
Nochmal Bitte sehr!
05.08.2009 16:29:00
Wolli
Hallo Klaus, ich hatte gehofft, dass Du das nicht willst, denn es ist etwas fummelig. :-)) Müsste aber gehen wie gewünscht. Passe bitte noch den Pfad an. Die Dateien werden dort hineingespeichert und geschlossen.
Gruß, Wolli
Sub splitten()
Dim wbMappe As Workbook, _
wbMappeAlt As Workbook, _
shBlatt As Worksheet, _
lngZeile As Long, _
strPfad As String
'Pfad festlegen (mit "\")
strPfad = "C:\Temp\"
'Erstmal alles in eine neue Mappe schaufeln
ActiveSheet.UsedRange.Cut
Set wbMappe = Workbooks.Add
wbMappe.Sheets(1).Paste
Application.CutCopyMode = False
Set shBlatt = ActiveSheet
Do
'falls vorhanden, die letzte Mappe speichern + schließen
If Not wbMappeAlt Is Nothing Then
wbMappeAlt.SaveAs Filename:=strPfad & _
CStr(wbMappeAlt.Sheets(1).Cells(1, 1).Value) & ".xls"
wbMappeAlt.Close
Set wbMappeAlt = Nothing
End If
'nächsten Bruch suchen
lngZeile = 1
Do
lngZeile = lngZeile + 1
'wenn Ende, dann Ende
If shBlatt.Cells(lngZeile, 1) = "" Then Exit Do
Loop Until shBlatt.Cells(lngZeile, 1)  Cells(lngZeile - 1, 1)
'wenn Ende, dann Ende
If shBlatt.Cells(lngZeile, 1) = "" Then Exit Do
'Rest ausschneiden und in neue Mappe verschieben
Range(shBlatt.Cells(lngZeile, 1), shBlatt.Cells(shBlatt.UsedRange.Rows.Count, _
shBlatt.UsedRange.Columns.Count)).Cut
Set wbMappeAlt = ActiveWorkbook 'Alte Mappe markieren
Set wbMappe = Workbooks.Add
Set shBlatt = wbMappe.Sheets(1)
wbMappe.Sheets(1).Paste
Application.CutCopyMode = False
Loop
'Am Ende die Aktive Mappe speichern und schließen.
ActiveWorkbook.SaveAs Filename:=strPfad & _
CStr(ActiveWorkbook.Sheets(1).Cells(1, 1).Value) & ".xls"
ActiveWorkbook.Close
End Sub

Anzeige
AW: Nochmal Bitte sehr!
05.08.2009 16:40:04
Klaus
You are the GODFATHER of excel! =)
Falls ich damit noch Probleme hab, werd ich nicht zögern, dich nochmals kurz zu nerven!! :)
Danke vielmals! (!!)
VIELE GRÜßE!
AW: Excel-Datei automatisch splitten
07.08.2009 10:44:52
Klaus
Hallo Wolli,
bin schon sehr weit gekommen mit deinem Makro.. Noch kurz eine Frage: Gibt es eine Möglichkeit bei dem Dateisplit, dass die erste Zeile in jede neue Datei übernommen wird. Diese soll nämlich in jeder Datei als Überschrift dienen?
Vielen Dank im Voraus
Klaus
So in etwa?
07.08.2009 12:43:59
Wolli 

Sub splitten()
Dim wbMappe As Workbook, _
wbMappeAlt As Workbook, _
lngZeile As Long, _
strPfad As String
'Pfad festlegen (mit "\")
strPfad = "C:\Temp\"
'Erstmal alles in eine neue Mappe schaufeln
ActiveSheet.UsedRange.Cut
Set wbMappe = Workbooks.Add
wbMappe.Sheets(1).Paste
Application.CutCopyMode = False
Do
'falls vorhanden, die letzte Mappe speichern + schließen
If Not wbMappeAlt Is Nothing Then
wbMappeAlt.SaveAs Filename:=strPfad & _
CStr(wbMappeAlt.Sheets(1).Cells(2, 1).Value) & ".xls"
wbMappeAlt.Close
Set wbMappeAlt = Nothing
End If
'nächsten Bruch suchen
lngZeile = 2 'wegen der Überschriften in Z. 2 beginnen!
Do
lngZeile = lngZeile + 1
'wenn Ende, dann Ende
If Cells(lngZeile, 1) = "" Then Exit Do
Loop Until Cells(lngZeile, 1)  Cells(lngZeile - 1, 1)
'wenn Ende, dann Ende
If Cells(lngZeile, 1) = "" Then Exit Do
'Rest ausschneiden und in neue Mappe verschieben
Range(Cells(lngZeile, 1), Cells(ActiveSheet.UsedRange.Rows.Count, _
ActiveSheet.UsedRange.Columns.Count)).Cut
Set wbMappeAlt = ActiveWorkbook 'Alte Mappe merken
Set wbMappe = Workbooks.Add
Application.Goto wbMappe.Sheets(1).Cells(2, 1)
ActiveSheet.Paste
wbMappeAlt.Sheets(1).Rows(1).Copy Destination:=ActiveSheet.Rows(1)
Application.CutCopyMode = False
Loop
'Am Ende die Aktive Mappe speichern und schließen.
ActiveWorkbook.SaveAs Filename:=strPfad & _
CStr(ActiveWorkbook.Sheets(1).Cells(2, 1).Value) & ".xls"
ActiveWorkbook.Close
End Sub
Ich habe auch sonst noch ein wenig herumoptimiert.
Gruß und schönes WE, Wolli
Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige