eventuelle kann mir von den Profis geholfen werden. Zwar habe ich schon einige Möglichkeiten durch die Recherche gefunden, aber meine Kenntnisse reichen leider nicht aus, um alles zusammen zu bringen.
Ich habe mir ein Makro zusammen gebastelt, welches eine Datei mit Hilfe des Textkonvertierungs-Assistenten in Excel öffnet und in weiteren Schnitten bearbeitet.
Nun möchte ich noch folgendes erreichen:
1. es sollen alle Dateien eines auswählbaren Verzeichnises mit diesem Makro nach Excel konvertiert und umgearbeitet werden (unterschiedliche Anzahl an Dateien, mit unterschiedlichen Dateinamen)
2. Die Daten aller konvertierten Dateien sollen in die Tabelle "Ergebnis" zusammengeführt werden, wobei die Daten ab der 2. Zeile in die nächte freie Zeile angefügt werden sollen. Die konvertierten Dateien haben eine unterschieliche Anzahl von Zeilen ab der 1. Zeile.
3. für die Datei mit der Tabelle "Ergebnis" soll der Befehl "Speichern unter" aufgefuren werden, wobei der Zielpfad = dem Quellpfad ist.
4. die zwischenzeitlich konvertierten Dateien können ohne zu speichern wieder geschlossen werden
************************************************************************************
Den ersten Eeil stelle ich mir etwa so vor:
Code habe ich im Archiv gefunden!
Public strPath As String
Private Sub CommandButton1_Click()
Msg = "Wählen Sie ein Verzeichnis aus," & Chr(13) & _
"dessen Inhalt angezeigt werden soll:"
strPath = GetDirectory(Msg)
If strPath = "" Then Exit Sub
Application.ScreenUpdating = False
Worksheets.Add after:=Worksheets(Worksheets.Count)
Application.StatusBar = _
"Bitte warten ... Verzeichnis- und Dateistruktur einlesen"
'Call BaumErstellen.getData(strPath)
Application.StatusBar = _
"Bitte warten ... Verzeichnisstruktur grafisch darstellen"
'Call BaumErstellen.baumZeichnen
Application.ScreenUpdating = True
End Sub
Nun beispielhaft mein bisheriger Ablauf:
Option Explicit
Sub DatenKonvertieren()
' hier der Ablauf für eine Datei soll abgeändert werden auf alle Dateien im gewählten verzeichnis
Workbooks.OpenText Filename:="D:\...\...\Test 26.04.2007", _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 9), Array(3, 9), Array(4, 9), Array(5, 1), Array(6, 1), Array(7, 9), Array(8, 9), _
Array(9, 9), Array(10, 9)), TrailingMinusNumbers:=True
Columns("A:A").Select
Selection.NumberFormat = "00000"
'Inhalte ab letzten werden gelöscht
Range("A65536").End(xlUp).Select
ActiveCell.Offset(rowoffset:=-4, columnoffset:=0).Rows.Activate
MsgBox ActiveCell.Address
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Clear
'Datum und Blatt-Nr. dem ersten zuordnen
Range("B14:C14").Select
Selection.Copy
Range("B18:C18").Select '& Range("A65536").End(xlUp).Row - 5).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows("1:17").Select
Selection.Delete shift:=xlUp
Application.CutCopyMode = False
Call LEERELOESCHEN
Range("B1:C1").Select
Selection.Copy
Range("B1:C" & Range("A65536").End(xlUp).Row).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Call TEXTELOESCHEN
End Sub
Sub LEERELOESCHEN() 'www.herber.de/forum/archiv/300to304/t300178.htm
Dim ii%, jj%
Dim leer As Boolean
For ii = ActiveSheet.Range("A65536").End(xlUp).Row To 1 Step -1
leer = True
For jj = 1 To 3
If ActiveSheet.Cells(ii, jj) "" Then leer = False
Next jj
If leer Then ActiveSheet.Cells(ii, 1).EntireRow.Delete
Next ii
End Sub
Sub TEXTELOESCHEN() 'www.herber.de/forum/archiv/912to916/t912630.htm (Sub löschen3())
With Columns(1)
.EntireRow.Sort key1:=Cells(1, 2), order1:=xlAscending, header:=xlNo
.AutoFilter Field:=1, Criteria1:="Identcode/Licence"
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End Sub
Zusammenführen ?
Ich hoffe meine Ausführungen waren verständlich
Gruß Jürgen