wenn jemand von euch mal etwas mehr Zeit haben sollte, könnte mir vielleicht einmal einen Tipp geben, wie ich folgendes Makro abkürzen bzw. professioneller gestalten kann... ;-)
Danke für eure Hilfe
Andreas
---------------------------
Sub Auslesen()
Application.ScreenUpdating = False
On Error GoTo Errorhandler
strPath = Sheets("Start").Range("Zielordner").Value
arrFiles = FileArray(strPath, "DBTippgeschäft*.txt")
Close
Sheets("Tippgeschäft").Select
Sheets("Tippgeschäft").Range("A6").Select
If Sheets("Tippgeschäft").Range("A6").Value <> "" Then
ergebnis2 = MsgBox("Tippgeschäft: Es befinden sich Daten auf dem Arbeitsblatt! Für Überschreiben drücken Sie 'JA', für Abbrechen 'Nein'!", vbYesNo + vbQuestion)
If ergebnis2 = vbYes Then
intRow = 6
GoTo Tippfüllen
Else: End If
GoTo Ende
Else: End If
intRow = 6
GoTo Tippfüllen
Tippanhängen:
While ActiveSheet.Cells(intRow, 1).Value <> ""
intRow = intRow + 1
GoTo Tippanhängen
Wend
GoTo Tippfüllen
Tippfüllen:
For intCounter = 1 To UBound(arrFiles)
Cells(intRow, 1) = arrFiles(intCounter)
Open strPath & arrFiles(intCounter) For Input As #1
Do Until EOF(1)
Line Input #1, txt
intRow = intRow + 1
Cells(intRow, 1) = txt
Loop
Close
intRow = intRow + 1
Next intCounter
arrFiles = FileArray(strPath, "DBUmsetzungsbegleitung*.txt")
Close
Sheets("Umsetzungsbegleitung").Select
Sheets("Umsetzungsbegleitung").Range("A6").Select
If Sheets("Umsetzungsbegleitung").Range("A6").Value <> "" Then
ergebnis3 = MsgBox("Umsetzungsbegleitung: Es befinden sich Daten auf dem Arbeitsblatt! Für Überschreiben drücken Sie 'JA', für Abbrechen 'Nein'!", vbYesNo + vbQuestion)
If ergebnis3 = vbYes Then
intRow = 6
GoTo Umsetzungfüllen
Else: End If
GoTo Ende
Else: End If
intRow = 6
GoTo Umsetzungfüllen
Umsetzunganhängen:
While ActiveSheet.Cells(intRow, 1).Value <> ""
intRow = intRow + 1
GoTo Umsetzunganhängen
Wend
GoTo Umsetzungfüllen
Umsetzungfüllen:
For intCounter = 1 To UBound(arrFiles)
Cells(intRow, 1) = arrFiles(intCounter)
Open strPath & arrFiles(intCounter) For Input As #1
Do Until EOF(1)
Line Input #1, txt
intRow = intRow + 1
Cells(intRow, 1) = txt
Loop
Close
intRow = intRow + 1
Next intCounter
arrFiles = FileArray(strPath, "DBVorsorgeerfolgsbericht*.txt")
Close
Sheets("Vorsorgeerfolgsbericht").Select
Sheets("Vorsorgeerfolgsbericht").Range("A6").Select
If Sheets("Vorsorgeerfolgsbericht").Range("A6").Value <> "" Then
ergebnis4 = MsgBox("Vorsorgeerfolgsbericht: Es befinden sich Daten auf dem Arbeitsblatt! Für Überschreiben drücken Sie 'JA', für Abbrechen 'Nein'!", vbYesNo + vbQuestion)
If ergebnis4 = vbYes Then
intRow = 6
GoTo Vorsorgeerfolgsberichtfüllen
Else: End If
GoTo Ende
Else: End If
intRow = 6
GoTo Vorsorgeerfolgsberichtfüllen
Vorsorgeerfolgsberichtanhängen:
While ActiveSheet.Cells(intRow, 1).Value <> ""
intRow = intRow + 1
GoTo Vorsorgeerfolgsberichtanhängen
Wend
GoTo Vorsorgeerfolgsberichtfüllen
Vorsorgeerfolgsberichtfüllen:
For intCounter = 1 To UBound(arrFiles)
Cells(intRow, 1) = arrFiles(intCounter)
Open strPath & arrFiles(intCounter) For Input As #1
Do Until EOF(1)
Line Input #1, txt
intRow = intRow + 1
Cells(intRow, 1) = txt
Loop
Close
intRow = intRow + 1
Next intCounter
MsgBox ("Daten wurden erfolgreich eingelesen")
Sheets("Start").Select
Sheets("Start").Range("A1").Select
GoTo Ende
Errorhandler:
MsgBox ("Es ist ein Fehler aufgetreten, möglicherweise befinden sich keine auszulesenden Textdateien im angegebenen Verzeichnis")
Ende:
Application.ScreenUpdating = False
End Sub
-------------------------------
Danke
Andreas