Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
608to612
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
608to612
608to612
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datensätze verteilen und speichern

Datensätze verteilen und speichern
10.05.2005 17:57:49
winni
Hallo Excel-Freunde,
ich moechte alle Datensätze der gleichen Nummer (Spalte 1) in einer neuen Datei unter dem Namen dieser Nummer speichen. Die 1. Zeile mit den Ueberschriften soll mit uebernommen werden.

Spalte1 Spalte2 Spalte3
2; Meier ;weitere Daten
2; Mueller ;weitere Daten
3; Schulz ;weitere Daten
3; Klein ;weitere Daten
3; Gross ;weitere Daten
4; Dick ;weitere Daten
4; Dünn ;weitere Daten
Dazu habe ich im Forum das nachstehende Makro gefunden. Leider gelingt es
mir nicht, die damit erzeugten Arbeitsmappen automatisch unter dem Namen der
Bearbeitungsnummer (Nr_3, Nr_3, ...) zu speichern.
Wie muss ich das Makro ergänzen?
Danke für euere Hilfe!
Option Explicit

Sub EgaleSpeichern()
Dim rng As Range, rngCur As Range
Dim lngRow As Long
Application.ScreenUpdating = False
Set rngCur = Range("A1").CurrentRegion
rngCur.Sort _
key1:=Range("A2"), _
order1:=xlAscending, _
header:=xlYes
lngRow = 2
Do Until IsEmpty(rngCur.Cells(lngRow, 1))
If rngCur.Cells(lngRow, 1) <> rngCur.Cells(lngRow - 1, 1) Then
rngCur.AutoFilter _
field:=1, _
Criteria1:=rngCur.Cells(lngRow, 1)
Set rng = rngCur.SpecialCells(xlCellTypeVisible)
Workbooks.Add
ActiveSheet.Name = rngCur.Cells(lngRow, 1)
rng.Copy Range("A1")
End If
lngRow = lngRow + 1
Loop
Worksheets(1).Select
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = False
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datensätze verteilen und speichern
11.05.2005 00:32:27
Reinhard
Hallo Winni,

Sub tt()
zei1 = 2
With ThisWorkbook.Worksheets("Tabelle1")
While .Cells(zei, 1) <> ""
Workbooks.Add
ActiveWorkbook.Name = "Nr_" & Left("000" & Cells(zei, 1), 3)
Cells(1, 1) = .Cells(1, 1)
Cells(1, 2) = .Cells(1, 2)
Cells(1, 3) = .Cells(1, 3)
zei2 = 2
Do
Cells(zei2, 1) = .Cells(zei1, 1)
Cells(zei2, 2) = .Cells(zei1, 2)
Cells(zei2, 3) = .Cells(zei1, 3)
zei1 = zei1 + 1
zei2 = zei2 + 1
While .Cells(zei1, 1) = .Cells(zei1 - 1, 1)
ActiveWorkbook.Close SaveChanges:=True
Wend
End With
End Sub

Gruß
Reinhard
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige