Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema RefEdit
BildScreenshot zu RefEdit RefEdit-Seite mit Beispielarbeitsmappe aufrufen

Makro Bereich kopieren und in neue Datei einfügen | Herbers Excel-Forum


Betrifft: Makro Bereich kopieren und in neue Datei einfügen von: Nicole
Geschrieben am: 11.08.2012 08:30:49

Hallo Zusammen,

ich habe ein Makro und bekomme nun den Fehler 450 und weiß nicht woran es liegt. Aus einer Stammdatei soll nach Gruppen (In Spalte A) gefiltert werden und jeweils in eine neue Datei mit der Formatierung gespeichert werden:

Sub Gruppe_speichern()
'Werte nach Gruppen aufteilen und in gesonderten Dateien sichern
'Die Werte aus den Spalten A:P sollen je Gruppe in gesonderten Arbeitsmappen
'in dem in Zelle G1 genannten Verzeichnis gespeichert werden.
'
'
' Inizialisierung
Dim rng As Range
Dim col As New Collection
Dim iRow As Integer
Dim bruch As Integer
Dim sFile As String
Dim Datei As String
Dim Zähler As Integer
Application.ScreenUpdating = False

'Startpunkt festlegen
iRow = 1

'Sicherungspfad holen
sFile = Range("G1").Value

On Error Resume Next

Zähler = 0

'Lesen der einzelnen Gruppen
Do Until IsEmpty(Cells(iRow, 1))
col.Add Cells(iRow, 1).Value, Cells(iRow, 1).Text
iRow = iRow + 1
Loop
On Error GoTo 0
Application.DisplayAlerts = False



For iRow = 2 To col.Count

Zähler = Zähler + 1

'Selection mittels autofilter der einzelnen Gruppen

Range("A1").CurrentRegion.AutoFilter field:=1, Criteria1:=col(iRow)
Set rng = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
rng.Copy

'Speicher der ausgewählten Zeilen

Application.ScreenUpdating = True
Workbooks.Add

'Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=  _
_
        False, Transpose:=False

ActiveSheet.Cells(2, 1).Select

Application.ScreenUpdating = False

Datei = ActiveSheet.Cells(2, 1).Value

'speichern der Daten in eine Exceldatei
ActiveWorkbook.SaveAs Filename:=sFile & Datei & ".xls"
Application.StatusBar = "Insgesamt:  " & Zähler & "  Dateien  " & _
" Datei wurde gespeichert als: " & ActiveWorkbook.Name
ActiveWorkbook.Close savechanges:=True



'nächste Gruppe
Next iRow
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ActiveSheet.AutoFilterMode = False
Application.StatusBar = ""

MsgBox "Die Datei wurde aufgeteilt in " & Zähler & " Dateien und gesichert", vbExclamation
'

End Sub

Vielen Dank im Voraus und viele Grüße

goldfoil

  

Betrifft: AW: Makro Bereich kopieren und in neue Datei einfügen von: Hajo_Zi
Geschrieben am: 11.08.2012 08:46:20

wir sehen nicht Deine Datein und wir sehen auch nicht in welcher Zeile der Fehler kommt.
Ich baue keine Datei nach, die Zeit hat schon jemand investiert. Ein Link zur Datei wäre nicht schlecht.

GrußformelHomepage


Beiträge aus den Excel-Beispielen zum Thema "Makro Bereich kopieren und in neue Datei einfügen"