|
Moin,
keine Lust das nachzubauen, daher nur mein Prinzip als Code
Sub Muster()
Application.ScreenUpdating = False
ActiveSheet.Copy 'temp Arbeitsblatt
Umlaute
Ausgeben
ActiveWorkbook.Close False
Application.ScreenUpdating = True
End Sub
Sub Ausgeben()
Dim rngU As Range, c As Range, d As Range
Dim strFile As String
Dim x As Long, z As Long
Set rngU = Sheets(1).UsedRange
z = rngU.Columns.Count
strFile = Replace(ThisWorkbook.FullName, "xlsm", "xml")
Open strFile For Output As #1
Print #1, "myHeader"
For Each c In rngU.Columns(1).Cells
Print #1, c.Text
For x = 1 To z - 1
'usw
Set d = c.Offset(, x)
If Not IsEmpty(d) Then Print #1, d.Text
Next x
'usw div loops
Next c
Close #1
End Sub
Sub Umlaute()
Const C_From As String = "Ä,Ö,Ü,ä,ö,ü,ß"
Const C_To As String = "Ae,Oe,Ue,ae,oe,ue,ss"
Dim rngU As Range
Dim arrFrom() As String, arrTo() As String
Dim x As Long
arrFrom = Split(C_From, ",")
arrTo = Split(C_To, ",")
Set rngU = Sheets(1).UsedRange
For x = LBound(arrFrom) To UBound(arrFrom)
rngU.Replace What:=arrFrom(x), Replacement:=arrTo(x), LookAt:=xlPart, MatchCase:=True
Next x
End Sub
|