Dateiname übernehmen?

Hallo, ich habe einen Makro geschrieben, welcher Inhalte von der Ausgangsdatei kopiert, in ein neues Dokument schreibt, wieder zurück zur Ausgangsdatei kehrt, sich neuen Inhalt holt etc...Auszug aus dem Code:
Workbooks.Add
Workbooks("Muster.xls").Worksheets("Tabelle1").Columns(1).Copy _
Destination:=ActiveWorkbook.Worksheets("Tabelle1").Range("A1")

Workbooks("Muster.xls").Worksheets("Tabelle1").Columns(spalte).Copy _
Destination:=ActiveWorkbook.Worksheets("Tabelle1").Range("B1")

'Speichern unter dem Namen der B Spalte / SaveAs TXT:
ActiveSheet.SaveAs (ActiveSheet.Cells(1, 2).Value) & ".txt", FileFormat:=xlText
'Workbooks.Close
Windows(Muster.xls).Activate
Die Datei, von der der Makro ausgeführt wird, heisst jedoch nicht Muster, sondern mal so mal so. Der Makro muss also den Namen der Ausgangsdatei übernehmen und Muster durch den Namen der Ausgangsdatei ersetzen...
Eine andere Möglichkeit wäre, die gespeicherte Datei gleich zu schließen, dann bekomm ich jedoch die Fehlermeldung "xx.txt hat nicht das MS EXCEL 97 Format..." ich müsste dann jedesmal auf "Ja" klicken...

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
Workbooks.Add
Windows(ThisWorkbook.Name).Activate
Aktiviert mir anschliessend wieder die Mappe, aus der das Makro aufgerufen wurde ?
Ausserdem glaube ich nicht, dass dein Makro überhaupt funktioniert
Hier definierst du die Ausgangsspalte
spalte = 2
Hier bestimmst du die Anzahl Leerzellen in Spalte 2
Anzahlleerzellen = Application.WorksheetFunction.CountBlank(Columns(2))
Und was machst du hier eigentlich ?
Ein "=" fehlt, kann also schonmal prinzipiell nicht tun
Do While Anzahlleerzellen 65536
' Solange bis komplett leere Spaltee kommt
Und hier würdest du für jeden Suchlauf eine neue Arbeitsmappe erstellen !!!
Workbooks.Add
Workbooks("Muster.xls").Worksheets("Tabelle1").Columns(1).Copy _
Destination:=ActiveWorkbook.Worksheets("Tabelle1").Range("A1")
Und warum willst du eine leere Spalte kopieren ?
Workbooks("Muster.xls").Worksheets("Tabelle1").Columns(spalte).Copy _
Destination:=ActiveWorkbook.Worksheets("Tabelle1").Range("B1")

'Speichern unter dem Namen der B Spalte / SaveAs TXT:
ActiveSheet.SaveAs (ActiveSheet.Cells(1, 2).Value) & ".txt", FileFormat:=xlText
'Workbooks.Close
Windows(Muster.xls).Activate Hier müsste dann die Anweisung hin
Windows(ThisWorkbook.Name).Activate
spalte = spalte + 1
Anzahlleerzellen = Application.WorksheetFunction.CountBlank(Columns(spalte))
Loop
-----------------
Hier mal mein Vorschlag


Sub Demo()
Dim i As Integer
Dim tarC As Integer
Dim qWkb As Workbook, tarWkb As Workbook
'Leere Spalte bestimmen
For i = 1 To 256
If Application.WorksheetFunction.CountBlank(Columns(i)) = 65536 Then
'Leere Spalte
tarC = i
Exit For
End If
Next i
'Variablen zuweisen
Set qWkb = Workbooks(ThisWorkbook.Name)
Set tarWkb = Workbooks.Add
'Kopiervorgang starten
qWkb.Worksheets("Tabelle1").Columns(1).Copy Destination:=tarWkb.Worksheets(1).Columns(1)
qWkb.Worksheets("Tabelle1").Columns(tarC).Copy Destination:=tarWkb.Worksheets(i).Range("B1")
Debug.Print tarWkb.Worksheets(1).Range("A2") & ".txt"
tarWkb.SaveAs tarWkb.Worksheets(1).Range("A2") & ".txt", FileFormat:=xlText
tarWkb.Close
End Sub

Gruss Rainer

Sub Demo() Dim i As Integer Dim tarC As Integer Dim qWkb As Workbook, tarWkb As Workbook 'Leere Spalte bestimmen For i = 1 To 256 If Application.WorksheetFunction.CountBlank(Columns(i)) = 65536 Then 'Leere Spalte tarC = i Exit For End If Next i 'Variablen zuweisen Set qWkb = Workbooks(ThisWorkbook.Name) 'Kopiervorgang starten For i = 1 To tarC - 1 Set tarWkb = Workbooks.Add qWkb.Worksheets("Tabelle1").Columns(1).Copy Destination:=tarWkb.Worksheets(1).Columns(1) qWkb.Worksheets("Tabelle1").Columns(i).Copy Destination:=tarWkb.Worksheets(i).Columns(2) tarWkb.SaveAs tarWkb.Worksheets(1).Range("A2") & ".txt", FileFormat:=xlText tarWkb.Close Next i End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread