Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Einzelne Blätter über Schleife speichern

VBA: Einzelne Blätter über Schleife speichern
11.09.2018 12:48:08
Bernd
Hallo zusammen,
Bräuchte mal Hilfe.
Mein Problem: einzelne Blätter als TXT-Datei speichern mit Dateiname aus Zelle und alles in einer Schleife, nicht wie der aufgezeichnete Code. In Tab1 Range D16:D20 sind die Dateinamen, ausser Tab1 alle Blätter (1,2,3,4,5) speichern im Pfad C:\Import.
Mit Makrorecorder aufgezeichneter Code
Sub BlaetterKopierenEinzelnSpeichern()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("1").Copy
ActiveWorkbook.SaveAs filename:="C:\Import\" & ThisWorkbook.Sheets("Tab1").Range("D16") & ". _
txt", FileFormat:=xlUnicodeText, CreateBackup:=False
ActiveWindow.Close
Sheets("Tab1").Select
Sheets("2").Copy
ActiveWorkbook.SaveAs filename:="C:\Import\" & ThisWorkbook.Sheets("Tab1").Range("D17") & ". _
txt", FileFormat:=xlUnicodeText, CreateBackup:=False
ActiveWindow.Close
Sheets("Tab1").Select
Sheets("3").Copy
ActiveWorkbook.SaveAs filename:="C:\Import\" & ThisWorkbook.Sheets("Tab1").Range("D18") & ". _
txt", FileFormat:=xlUnicodeText, CreateBackup:=False
ActiveWindow.Close
Sheets("Tab1").Select
Sheets("4").Copy
ActiveWorkbook.SaveAs filename:="C:\Import\" & ThisWorkbook.Sheets("Tab1").Range("D19") & ". _
txt", FileFormat:=xlUnicodeText, CreateBackup:=False
ActiveWindow.Close
Sheets("Tab1").Select
Sheets("5").Copy
ActiveWorkbook.SaveAs filename:="C:\Import\" & ThisWorkbook.Sheets("Tab1").Range("D19") & ". _
txt", FileFormat:=xlUnicodeText, CreateBackup:=False
ActiveWindow.Close
Sheets("Tab1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Für Hilfestellungen bedanke ich mich im Voraus!!!
Userbild
Office Version 2016 Pro 32bit - Windows10 Pro 64 bit
"Wenn du jemanden ohne Lächeln triffst, schenke ihm dein's!"

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Probiere es mal so der...
11.09.2018 13:06:03
Case
Hallo Bernd, :-)
... Spur nach: ;-)
Option Explicit
Sub Main()
Dim lngTMP As Long
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
With ThisWorkbook
For lngTMP = 2 To .Worksheets.Count
.Worksheets(lngTMP).Copy
ActiveWorkbook.SaveAs Filename:="C:\Import\" & _
.Worksheets("Tab1").Range("D" & lngTMP + 14) & ".txt ", _
FileFormat:=xlUnicodeText
ActiveWorkbook.Close False
Next lngTMP
End With
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Alle Tabellenblätter - exklusive des ersten Blattes - werden gespeichert. Überschreiben ohne Nachfrage.
Servus
Case

Anzeige
AW: Probiere es mal so der...
11.09.2018 13:16:42
Bernd
Hallo Case,
♥lichen Dank für deine schnelle Hilfestellung!!!
Genauso hatte ich mir es gedacht, passt wie die Faust auf's Auge ;-)
Sonnige Grüße aus Bremen
Bernd
AW: VBA: Einzelne Blätter über Schleife speichern
11.09.2018 13:09:24
Werner
Hallo Bernd,
versuch mal:
Sub BlaetterKopierenEinzelnSpeichern()
Dim i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To 5
Sheets(CStr(i)).Copy
ActiveWorkbook.SaveAs Filename:="C:\Import\" & ThisWorkbook.Sheets("Tab1").Range("D" & i +  _
15) _
& ".txt ", FileFormat:=xlUnicodeText, CreateBackup:=False
ActiveWindow.Close
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Gruß Werner
Anzeige
AW: VBA: Einzelne Blätter über Schleife speichern
11.09.2018 13:22:42
Bernd
Hallo Werner,
♥lichen Dank auch dir für Deine Hilfe!!!
Dein Code funktioniert prima!!!
Ich lasse offen, für welchen Code von Euch Beiden ich mich entschieden habe.
Auch dir sonnige Grüße aus bremen
Bernd
Gerne u.Danke für die Rückmeldung. o.w.T.
11.09.2018 21:16:32
Werner
AW: VBA: Einzelne Blätter über Schleife speichern
11.09.2018 13:29:42
Rob

Sub TxtDateien()
Dim i As Integer
For i = 2 To 5
Sheets(i).Copy
ActiveWorkbook.SaveAs "C:\Import\" & Cells(i + 14, 4) & ".txt "
ActiveWindow.Close
Next i
End Sub

AW: VBA: Einzelne Blätter über Schleife speichern
11.09.2018 14:02:34
Bernd
Hallo Rob,
Danke für die Hilfe. Dein Code funktioniert nicht. Dia Saveas-Methode meldet Fehler.
Gruß
Bernd
AW: VBA: Einzelne Blätter über Schleife speichern
11.09.2018 14:09:39
Rob
Hi Bernd,
welche Fehlermeldung erhältst Du? Wenn Du den Code direkt ins Arbeitsblatt einfügst und nicht über ein Modul ausführst, dann sollte es funktionieren. Ansonsten noch auf das Arbeitsblatt verweisen:

For i = 2 To 5
Sheets(i).Copy
ActiveWorkbook.SaveAs "C:\Users\diolq569\Desktop\" & Sheets(1).Cells(i + 14, 4) & ". _
txt "
ActiveWindow.Close
Next i

Anzeige
AW: VBA: Einzelne Blätter über Schleife speichern
11.09.2018 14:11:10
Rob
PS: Noch das Verzeichnis "C:\... " ändern - have versehentlich meins reinkopiert. :-)

327 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige