title image


Smiley Und bist du nicht willig (EXCEL) ....
Hallo



dann machen wir es eben selbst ;-)



Probiers mal mit einer der beiden Varianten



Sub Export_Comma_CSV()    '(C) Ramses    'Exportiert EXCEL-Daten in ein CSV-Sheet in der Form    ''1','2','3','rainer@e-maile.de',',,,    Dim i As Long, n As Integer    Dim expPath As String, expFile As String, expStr As String, expDiv As String, expDelimiter As String    expPath = "C:\" 'Exportpfad    expFile = "sqlImport.csv"    expDiv = "'"    expDelimiter = ";"    Close #1    Open expPath & expFile For Append As #1    'Die Daten beginnen in Apalte A    For i = 1 To Range("A65536").End(xlUp).Row        expStr = ""        'Die Daten beginnen in Zeile 2        'Die Header stehen in Zeile1 !!!        'Dort müssen alle Spalten beschriftet sein, die verwendet werden        'Alternativ kann auch manuell "For n = 1 To 10" verwendet werden        For n = 1 To Range("IV1").End(xlToLeft).Column            If n = 1 Then                expStr = expDiv            End If            expStr = expStr & Cells(i, n).Value & expDiv & expDelimiter        Next n        Print #1, Left(expStr, Len(expStr) - 1)    Next i    Close #1End SubSub Export_Comma_CSV_from_VarRange()    '(C) Ramses    'Exportiert EXCEL-Daten in ein CSV-Sheet in der Form    ''1';'2';'3';'rainer@e-maile.de';;;;;;;    'Der Exportbereich kann frei definiert werden    Dim i As Long, n As Integer    Dim expPath As String, expFile As String, expStr As String, expDelimiter As String    Dim expRange As Range, myC As Range    Dim startRow As Integer, startCol As Integer, endCol As Integer, tmpRow As Integer    expPath = "C:\" 'Exportpfad    expFile = "sqlImport.csv"    expDelimiter = ";"    On Error Resume Next    Set expRange = Application.InputBox("Markieren Sie den Bereich der exportiert werden soll", "CSV Export", Type:=8)    On Error GoTo 0    If expRange Is Nothing Then        MsgBox "Export abgebrochen"        Exit Sub    End If    If Intersect(Range(ActiveCell.Address), Range(ActiveCell.Offset(0, 1).Address)) Is Nothing Then        MsgBox "Auswahl des Exportbereiches muss von links oben nach rechts unten erfolgen" _            & vbCrLf & "und muss mindestens 2 Spalten umfassen", vbCritical + vbOKOnly, "Abbruch"        Exit Sub    End If    Close #1    Open expPath & expFile For Output As #1    For Each myC In expRange        If startRow = 0 Then            startRow = ActiveCell.Row            startCol = ActiveCell.Column            endCol = startCol + expRange.Columns.Count            tmpRow = ActiveCell.Row        End If        If myC.Row > tmpRow Then            Print #1, Left(expStr, Len(expStr) - 1)            expStr = myC.Value & expDelimiter            tmpRow = myC.Row        Else            expStr = expStr & myC.Value & expDelimiter            Debug.Print expStr        End If    Next    Print #1, Left(expStr, Len(expStr) - 1)    Close #1    Set expRange = Nothing    MsgBox "Export abgeschlossen"End Sub




Herzliche Grüsse

aus der Schweiz

Rainer

Kombiniere Geist und Google,...denn Wissen ist geil :-)



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: