Clever-Excel-Forum

Normale Version: Tabelle automatisch in mehrere Dateien speichern
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Hallo zusammen, vorab möchte ich mich kurz vorstellen. Ich bin der Ulli, 58 Jahre und nutze Excel zum kalkulieren von Preisen.
Nun habe ich folgendes vor: 
Ich möchte aus einer Sammelliste mit einer VBA Formel automatisch einzelne Dateien erzeugen. Dazu habe ich in einem alten
Excel Forum einen Code gefunden, mit dem das soweit schon mal hervorragend klappt. 
Die Bezeichnung der einzeln gespeicherten Dateien kommt aus Spalte A. Alle Einträge mit gleichen Namen werden in einer neuen
Datei gespeichert. 
Was mir in der Formel fehlt, wäre die Definition, das nur ein bestimmter Spaltenbereich (z.B. von Spalte "B" bis Spalte "AC")
in der neuen Datei gespeichert wird. Mit der bisherigen Formel müsste ich in jeder erzeugten Datei (zurzeit ca. 50 Dateien)
die erste Spalte raus löschen.

Darf ich den Code oder den Link zum alten Forumbeitrag hier posten (was ja nötig wäre, damit man weiter helfen kann) 21 ?

Ich freue mich auf Antworten und Unterstützung und wünsche schon mal einen schönen Tag
Ulli
Zitat:Darf ich den Code oder den Link zum alten Forumbeitrag hier posten (was ja nötig wäre, damit man weiter helfen kann)



Hallo Ulli

Wenn alles soweit klappt wäre der Code hilfreich. Müsste dann ja nur noch mit entferne Spalte A ergänzt werden.

Aber warum möchtest du eigentliche deine Datenbank in 50 kleine Zerpflücken?

Gruß Elex
Hallo Elex,
ich benötige einzelne Dateien für einen Shop-Upload. Das bearbeiten mit einer Sammelliste ist deutlich einfacher und schneller
als jede Datei einzeln abzuarbeiten. Aber für diese Einsicht habe ich auch Jahre gebraucht, manchmal bin ich da etwas träge Shy

Ich suche gleich mal, aus welchem Forum ich den Code habe, dann kann ich das ja mit angeben, damit es keinen Ärger wegen
Urheber und Co. gibt, wenn ich den Code hier poste.

Viele Grüße
Ulli

Hier der Code:

Sub Sammelliste_aufsplitten()
    Dim MyDic As Object, rng As Range, Zelle As Range, ws As Worksheet, wb As Workbook
    Application.ScreenUpdating = False
    Set MyDic = CreateObject("Scripting.Dictionary")
    Set ws = ActiveSheet
    With ws
        Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
        For Each Zelle In rng.Offset(1, 0)
            If MyDic(Zelle.Value) = "" And Not IsEmpty(Zelle) Then
                MyDic(Zelle.Value) = 1
                rng.AutoFilter field:=1, Criteria1:=Zelle
                Set wb = Workbooks.Add
                .UsedRange.SpecialCells(xlCellTypeVisible).Copy wb.Sheets(1).Cells(1, 1)
                wb.SaveAs Filename:=ThisWorkbook.Path & "\" & Zelle & ".xlsx", FileFormat:=51
                wb.Close False
                rng.AutoFilter
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub


Ich habe ihn hier gefunden:
http://www.office-loesung.de/ftopic552701_0_0_asc.php

Wichtig wäre, das ich ab Spalte "B" oder "C" (da bin ich mir noch nicht sicher, ob ich neben
dem Dateinamen in Spalte A noch eine laufende Nummer in Spalte B hinzu füge) bis
zu Spalte AC eingrenzen kann. Ab Spalte AD folgen noch Spalten mit der Kalkulation, die
auch nicht in den einzelnen Dateien erscheinen sollen.

Viele Grüße
Ulli
Hallo, 19 

wenn sonst alles funktioniert, schreibe statt...

Code:
.UsedRange.SpecialCells(xlCellTypeVisible).Copy wb.Sheets(1).Cells(1, 1)

... das: 21 

Code:
.UsedRange.Columns("B:AC").SpecialCells(xlCellTypeVisible).Copy wb.Sheets(1).Cells(1, 1)
Hallo Case,
wow, perfekt Shy .
So funktioniert es wie ich es mir vorgestellt habe.

Ganz lieben Dank dafür, das erspart mir heftig viel Zeit.

Viele Grüße und einen guten an alle Leser
Ulli