@Alex: Textexport
06.05.2016 16:09:34
Michael
da hast Du ja einen "Super Effekt" erzeugt - sicher nicht absichtlich - indem Du den Forums-link auf Deine Datei so verhunzt hast, daß jeder Klick irgendwohin die Datei herunterlädt.
Selbst die Eingabe eines schließenden </a> konnte es nicht beheben...
Also gut: Du bist uns den halben Code schuldig geblieben, denn in
https://www.herber.de/forum/archiv/1476to1480/t1478417.htm
steht auch Franz' Funktion
Sub Tabellen_als_Text_speichern()
, die ja die eigentliche Arbeit macht.Die ist aber so allgemein gehalten, daß ich sie gar nicht erst anfassen mag.
Es geht auch so:
1. alle Einzelblätter in ein "summarisches" kopieren
2. dieses an "Franz" übergeben
Also so (ich habe den Code in das "Modul1" gesteckt, Button auf Blatt "Menü":
Option Explicit
Sub Tabellen_als_Text_speichernMichael()
Dim wkb_Q As Workbook, wks_Q As Worksheet, wks_Z As Worksheet, bolOK As Boolean
Dim zeile As Long
Const Spalte = "A" ' wozu leere Spalte A exportieren?
Const BlattName = "105397_Ausgabe" ' so heißt die Datei dann auch hinterher
Set wkb_Q = ActiveWorkbook
On Error Resume Next
Set wks_Z = Sheets(BlattName)
If Err.Number 0 Then
Set wks_Z = Worksheets.Add
With wks_Z
.Name = BlattName
.Move after:=Sheets(1)
End With
End If
On Error GoTo 0
wks_Z.Cells.Clear
'Alle Tabellenblatt in der Arbeitsmappe als Text-Datei speichern
zeile = 1 ' wozu leere Zeilen exportieren?
For Each wks_Q In wkb_Q.Worksheets
If wks_Q.Name BlattName And wks_Q.Name "Menü" Then
wks_Q.Range("B11:I40").Copy wks_Z.Range("A" & zeile)
zeile = zeile + 31 ' 31, wenn Leerzeile erwünscht, sonst 30
End If
Next
Stop
bolOK = fncSave_as_Text( _
strPfad:="C:\A_Herber\", _
wks:=wks_Z, _
lngFileFormat:=23, _
bolRename:=True) 'Parameter ggf. anpassen
' oben bitte beachten: wks_Q wurde durch wks_Z ersetzt!
If Not bolOK Then
MsgBox "Makro wird wegen Fehler abgebrochen", _
vbOKOnly, "Speichern als Text-Datei"
End If
If bolOK Then
MsgBox "Fertig!", vbInformation + vbOKOnly, "Speichern als Text-Datei"
End If
End Sub
Die Datei: https://www.herber.de/bbs/user/105426.xlsm
Schöne Grüße,
Michael
P.S.: ich sehe gerade, daß der Code beim "Stop" stehenbleibt: das kannst Du auskommentieren oder löschen.