Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1192to1196
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Spalten exportieren

Spalten exportieren
George
Hallo liebe Forumsteilnehmer,
bitte entschuldigt das ich nochmals den Artikel veröffentliche. Leider hatte ich keine Antwort zum VBA Code erhalten, daher möchte ich es einfach nochmal probieren. Ich hoffe das ist o.k.
ich habe eine Tabelle mit den Spalten A-H und einer unbestimmten Anzahl an Zeilen.
Ich möchte nun die Spalten A-F, bis zu letzten Zeile als Txt Datei speichern oder alternativ in ein
neues Blatt kopieren.
Bei meiner Recherche bin ich auf folgendes Makro gekommen, was mir sehr gut gefallen hat.
Bei der Ausführung werden allerdings nur zwei Zeilen kopiert und gespeichert. Kann mir jemand
behilflich sein was hier geändert werden muss.
Vielen Dank
George
Nachfolgend der Code aus dem Forum
Sub export_selected_Range_and_save_as_TXT()
'(C) by Ramses
'Exportiert einen ausgewählten Bereich in ein zu definierendes Textfile
Dim i As Integer, n As Integer, maxExpCol As Integer, QE As Integer
Dim StartRow As Integer, StartCol As Integer, selRow As Integer, selCol As Integer
Dim myC As Range
Dim expFolder As String, expFileName As String
Dim myDiv As String, tmpExpText As String, expText As String
'Maximal zu exportierende Spalten
'Dieser Parameter ist anzupassen, um unterschiedliche Bereich
'in ein einheitliches Exportformat zu bringen
maxExpCol = 25
'Default Pfad incl abschliessendem Backslash
expFolder = "C:\Temp\"
'Standard Name für TextExportFile
expFileName = "Koordinaten.txt"
'Ab hier keine Änderungen mehr vornehmen
'Trennzeichen für das Textfile
myDiv = ";"
If Selection.Columns.Count > maxExpCol Then
MsgBox "Maximal zu exportierende Spaltenzahl überschritten"
Exit Sub
End If
'Starbereich festlegen
StartRow = Selection.Range("A1").Row
StartCol = Selection.Range("A1").Column
'Scheifenparameter initialisieren
selRow = Selection.Rows.Count
selCol = Selection.Columns.Count
For i = StartRow To StartRow + selRow
tmpExpText = ""
For n = StartCol To StartCol + selCol
tmpExpText = tmpExpText & Cells(i, n).Text & myDiv
Next n
'Exportfile auf erforderliche Länge bringen
If Len(tmpExpText)  "" Then
QE = MsgBox("Sollen die Daten an die existierende Datei angehängt werden," & vbCrLf & _
"oder soll die Datei überschrieben werden ?" & vbCrLf & vbCrLf & _
"JA = Anhängen" & vbCrLf & "NEIN = Datei überschreiben" & vbCrLf & "ABBRECHEN =  _
Abbrechen", _
vbYesNoCancel + vbCritical + vbDefaultButton1, "Exportverhalten definieren")
If QE = vbCancel Then Exit Sub
If QE = vbYes Then
'Daten anhängen
Open expFileName For Append As #1
Print #1, expText
Close #1
Else
'Daten überschreiben
Open expFileName For Output As #1
Print #1, expText
Close #1
End If
Else
'Daten erstmalig schreiben
Open expFileName For Output As #1
Print #1, expText
Close #1
End If
MsgBox "Daten exportiert"
End Sub

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Spalten exportieren
17.01.2011 13:49:35
Rudi
Hallo,
das Makro exportiert den markierten Bereich.
Gruß
Rudi
AW: Spalten exportieren
17.01.2011 14:09:41
George
O.k. habe verstanden und wenn ich den bereich markiere wird auch exportiert. Jetzt habe ich noch festgestellt ich benötige als Ausgabe eine Text MS-Dos Datei. Wie müßte ich denn das Makro ändern um das zu erhalten. Vielen Dank und Beste Grüße
George
AW: Spalten exportieren
17.01.2011 13:55:49
Tino
Hallo,
vielleicht geht es auch mit diesem Code.
Die Tabelle wird in eine neue Datei kopiert.
Spalte G bis zur letzten Spalte gelöscht und als Textdatei gespeichert.
Sub Makro1()
Dim SpeicherPfad_TxT$

'Pfad anpassen, am Ende auf "\" achten 
SpeicherPfad_TxT$ = "G:\Ordner\"

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    
    'Tabelle anpassen 
    Sheets("Tabelle1").Copy
    
    With ActiveWorkbook
        With .ActiveSheet
            .Range(.Columns(7), .Columns(.Columns.Count)).Delete
        End With
        
        .SaveAs Filename:=SpeicherPfad_TxT & Format(Now, "dd_mm_yyyy_hh_mm_ss") & ".txt", _
                FileFormat:=xlUnicodeText, CreateBackup:=False
        .Close False
    End With

    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
End Sub
Gruß Tino
Anzeige
AW: Spalten exportieren
17.01.2011 14:11:18
George
Hallo Tino,
besten Dank, ich erhalte jedoch folgende Fehlermeldung
"Index außerhalb des gültigen Bereichs"
Was kann ich tun?
Gruss
George
hast Du den Tabellennamen angepasst? oT.
17.01.2011 14:15:16
Tino
AW: hast Du den Tabellennamen angepasst? oT.
17.01.2011 14:18:34
George
Hallo Tino,
das wars, jetzt passiert auch etwas. Vielen Dank.
Gruss
George
wegen Text MS-Dos
17.01.2011 14:19:09
Tino
Hallo,
ersetze noch
FileFormat:=xlUnicodeText
durch dies
FileFormat:=xlTextMSDOS
Gruß Tino
AW: wegen Text MS-Dos
17.01.2011 14:55:18
George
Hi Tino,
super, danke dir vielmals. Vielleicht hast du ja noch eine ergänzende Lösung. Der Export soll erst in Zeile 3 beginnen und dann bis zum Blattende gehen, also bis zum letzten Eintrag in Spalte "A".
Beste Grüße
George
Anzeige
müsste so funktionieren.
17.01.2011 15:45:50
Tino
Hallo,
ich lösche einfach die Zeile 1 und 2 und alles unterhalb der letzten gefüllten Zelle in Spalte A.
Sub Makro1()
Dim SpeicherPfad_TxT$

'Pfad anpassen, am Ende auf "\" achten 
SpeicherPfad_TxT$ = "G:\Ordner\"

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    
    'Tabelle anpassen 
    Sheets("Tabelle1").Copy
    
    With ActiveWorkbook
        With .ActiveSheet
            .Range(.Columns(7), .Columns(.Columns.Count)).Delete
            .Rows("1:2").Delete
            .Range(.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0), .Cells(.Rows.Count, 1)).EntireRow.Delete
        End With
        
        .SaveAs Filename:=SpeicherPfad_TxT & Format(Now, "dd_mm_yyyy_hh_mm_ss") & ".txt", _
                FileFormat:=xlTextMSDOS, CreateBackup:=False
        .Close False
    End With

    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
End Sub
Gruß Tino
Anzeige
AW: müsste so funktionieren.
17.01.2011 16:12:36
George
Hi Tino,
das ist einfach Super. Vielen Vielen Dank!
Gruss
George

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige