Supportnet / Forum / Tabellenkalkulation

Hallo, ich hab ein kleines (großes) Problem und hoffe hier Hilfe zu bekommen, da meine Excel Kenntnissen nicht wirklich weit reichen. Ich hab eine große Excelliste mit mehren Daten gefüttert und möchte nun, wenn ich auf den Wert in A1 klicke (oder auf einen Button oder ähnliches), das sich ein neues Excel Dokument öffnet und Werte aus der Zeile B1,C1 & D1 in das neue Dokument an anderer Stelle eingefügt werden. Zusätzlich soll der Dateiname des Neu erstellten Dokumentes aus den Werten von A1 und B3 zusammensetzen, mit einem "_" getrennt. Das ganze soll auch mit den Werten in der Spalte A2, B2, C2 & D2 funktionieren, die dann (logischerweise) in ein weiteres neu erstelltes Dokument übernommen werden sollen und so weiter... Ist sowas mit Excel machbar? Danke schonmal für Eure Tips :-) Gruß comA

Moin comA,

abgesehen das einige Informationen fehlen und die die du gibst sich zum Teil wiedersprechen, ist das machbar.

Folgender Code, den man auch einem CommandButton zuweisen kann, kopiert die Werte der Activen Mappe zeilenweise in je eine neu erstellt Mappe. Die neue Mappe wird anhand der Werte die in den Spalten A und B der entsprechenden Zeile stehen benannt.

Option Explicit

Sub Neue_Mappe()
Dim Quelldatei As String, Zieldatei As String, loZeile As Long
Application.ScreenUpdating = False
Quelldatei = ActiveWorkbook.Name
For loZeile = 1 To Workbooks(Quelldatei).Sheets("Tabelle1"). _
Cells(Rows.Count, 1).End(xlUp).Row
Zieldatei = Workbooks(Quelldatei).Sheets("Tabelle1").Cells(loZeile, 1) & _
"_" & Workbooks(Quelldatei).Sheets("Tabelle1").Cells(loZeile, 2)
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"C:\Dokumente und Einstellungen\user\Desktop\Daten\" & Zieldatei, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Workbooks(Quelldatei).Sheets("Tabelle1").Rows(loZeile).Copy _
Destination:=Workbooks(Zieldatei).Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Workbooks(Zieldatei).Save
Workbooks(Zieldatei).Close
Next
Application.ScreenUpdating = True
End Sub

Als Zielordner für die neuen Dateien, habe ich auf dem Desktop einen Ordner "Daten" angelegt.

Gruß

JöKe

Hi Jörg,

vielen Dank erstmal für Deine Antwort.

Ich hab noch eine Frage.
So wie ich das jetzt verstanden habe füge ich in Deine Vorlage, die von mir gewünschten Spaltennummern für z.B. die Zeile A ein und das ganze sollte laufen.

Funktioniert das ganze dann auch mit Zeile B wenn ich den CommandButton einfach kopiere und in Zeile B einfüge, oder muß ich die Zeilennummer dann händisch auf B abändern?

Gruß comA

Hallo comA,

wo willst du was einfügen?

Du brauchst ansich nur den Speicherort anpassen.

"C:\Dokumente und Einstellungen\user\Desktop\Daten\" & Zieldatei, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

Und ein CommandButton erstellen und diesem das Makro zuweisen.

Und wenn die neuen Dateien nicht nach den Werten in Spalte A und Spalte B benannt werden sollen, das dementsprechend ändern.

Zieldatei = Workbooks(Quelldatei).Sheets("Tabelle1").Cells(loZeile, 1) & _
"_" & Workbooks(Quelldatei).Sheets("Tabelle1").Cells(loZeile, 2)


Gruß

JöKe

So, ich habe es jetzt getestet und bekomme noch einen Laufzeitfehler ´9´. Im Debug markiert er mir folgende Zeilen:

Workbooks(Quelldatei).Sheets("Tabelle1").Rows(loZeile).Copy _
Destination:=Workbooks(Zieldatei).Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

Der Wert in "End(xlUp)" ist -4162, ich glaube da liegt das Problem.

Hier der gesamte Code, ich habe versucht das ganze über einen Command Button einzufügen.

Option Explicit
Private Sub CommandButton1_Click()

Dim Quelldatei As String, Zieldatei As String, loZeile As Integer
Application.ScreenUpdating = False
Quelldatei = ActiveWorkbook.Name
For loZeile = 1 To Workbooks(Quelldatei).Sheets("Tabelle1"). _
Cells(Rows.Count, 1).End(xlUp).Row
Zieldatei = Workbooks(Quelldatei).Sheets("Tabelle1").Cells(loZeile, 1) & _
"_" & Workbooks(Quelldatei).Sheets("Tabelle1").Cells(loZeile, 2)
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\bd099954\Desktop\Listen\Abnahmeprotokolle\" & Zieldatei, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Workbooks(Quelldatei).Sheets("Tabelle1").Rows(loZeile).Copy _
Destination:=Workbooks(Zieldatei).Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Workbooks(Zieldatei).Save
Workbooks(Zieldatei).Close
Next
Application.ScreenUpdating = True
End Sub

Die neue Excel Datei wird erstellt und heißt auch richtig, nur bleibt eben leer.

Hast Du noch einen Tip für mich?

Gruß comA

Ah, du hast schon wieder geantwortet :)

Ich erkläre am besten noch einmal genau was ich machen will.

Ich habe eine Liste mit 300 Zeilen, jede Zeile steht für eine Lokation (Ort, PLZ, Strasse etc.).

Jetzt will ich für jede Lokation ein Abnahmeprotkoll erstellen welches nach PLZ, und Ort der benannt wird.

Zusätzlich sollen in jedes Abnahmeprotkoll noch Werte aus der jeweilgen Zeile übergeben werden.

Ich hoffe ich habe es jetzt etwas verständlicher ausgedrückt.

Gruß comA

Hallo comA,

schon verständlich.
Versuch es mal hiermit:

Option Explicit

Sub Neue_Mappe()
Dim Quelldatei As String, Zieldatei As String, loZeile As Long, _
loletzte1 As Long, loletzte2 As Long
Application.ScreenUpdating = False
Quelldatei = ActiveWorkbook.Name
loletzte1 = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1) _
.End(xlUp).Row, Rows.Count)
For loZeile = 1 To loletzte1
Zieldatei = Workbooks(Quelldatei).Sheets("Tabelle1").Cells(loZeile, 1) & _
"_" & Workbooks(Quelldatei).Sheets("Tabelle1").Cells(loZeile, 2)
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"C:\Dokumente und Einstellungen\user\Desktop\Daten\" & Zieldatei, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
loletzte2 = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1) _
.End(xlUp).Row, Rows.Count)
Workbooks(Quelldatei).Sheets("Tabelle1").Rows(loZeile).Copy _
Destination:=Workbooks(Zieldatei).Sheets("Tabelle1").Cells(loletzte2 + 1, 1)
Workbooks(Zieldatei).Save
Workbooks(Zieldatei).Close
Next
Application.ScreenUpdating = True
End Sub

Das musst du deine Vorgaben natürlich wieder anpassen.

Gruß

JöKe

Hmm,

ich bekomme immernoch nen Laufzeitfehler. "Index außerhalb des gültigen Bereichs".

Workbooks(Quelldatei).Sheets("Tabelle1").Rows(loZeile).Copy _
Destination:=Workbooks(Zieldatei).Sheets("Tabelle1").Cells(loletzte2 + 1, 1)

Gruß comA

Hi,

haben deine Blätter Namen?
Wenn ja musst du diese anstelle von Tabelle1 angeben.

Gruß

JöKe

Ich hab nur ein Tabellenblatt und das extra in "Tabelle1" umbenannt :(

Gruß comA

Hallo,

füge mal ein .xls ein:

ActiveWorkbook.SaveAs Filename:= _
"C:\Dokumente und Einstellungen\user\Desktop\Daten\" & Zieldatei & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

Sieht jetzt so aus:

"C:\Documents and Settings\bd099954\Desktop\Listen\Abnahmeprotokolle\" & Zieldatei & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _

aber der Fehler ist der gleiche...

Gruß comA

überprüfe bitte noch einmal den Blattnamen in der Mappe und im Code. Sobald dort unterschiede auftreten, und sei es nur ein Leerzeichen, kommt es zu dieser Fehlermeldung.

Gruß

• dokument lässt sich nicht öffnnen
• Fehlermeldung beim Öffnen eines MS-Word 03-Dokumentes
• Viste Sorgen
• Word Dokument zu groß, lässt sich nicht mehr öffnen