habe folgendes Makro um Datein nach Excel zu importieren. Nun möchte ich aber das die neuen Daten nicht immer in einem festgelegten Bereich geschrieben werden sondern immer in die nächste freie Zeile. Wenn meine Tabelle bereits bis Zeile 360 gefüllt, sollen die nächsten Daten, nachdem ich sie ausgewählt hab, automatisch in 361 eingetragen werden und die bereits vorhanden daten überschreiben.
[Code]
Option Explicit
Option Base 1
Private Sub CommandButton1_Click()
Dim FileName As String
Dim FileNum As Integer
Dim ResultStr As String
Dim wsSheet As Worksheet
Dim strValues(65536, 1) As String
Dim lngRow As Long
Dim intSheet As Integer
Dim intCounter As Integer
ActiveCell.Activate
FileName = Application.GetOpenFilename("Textdateien " _
& "(*.txt; *.csv),*.txt; *.csv")
If FileName = "" Or FileName = "Falsch" Then Exit Sub
FileNum = FreeFile()
Open FileName For Input As #FileNum
Application.ScreenUpdating = False
ActiveSheet.Select
lngRow = 1
intSheet = 1
Application.StatusBar = "Blatt " & intSheet & " wird eingelesen"
Do While Seek(FileNum) <= LOF(FileNum)
Line Input #FileNum, ResultStr
If Left(ResultStr, 1) = "=" Then
strValues(lngRow, 1) = "'" & ResultStr
Else
strValues(lngRow, 1) = ResultStr
End If
If lngRow < 65536 Then
lngRow = lngRow + 1
Else
ActiveSheet.Range("A6:A1000") = strValues
ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
lngRow = 1
intSheet = intSheet + 1
Application.StatusBar = "Blatt " & intSheet & " wird eingelesen"
End If
Loop
Close
ActiveSheet.Range("A6:A1000") = strValues
If MsgBox("Sollen die eingelesenen Daten auf Spalten verteilt werden?", _
vbYesNo, "Text in Spalten") = vbNo Then
Application.ScreenUpdating = True
Application.StatusBar = "Fertig"
Exit Sub
End If
intSheet = 0
For Each wsSheet In ActiveWorkbook.Worksheets
intSheet = intSheet + 1
Application.StatusBar = "Daten von Blatt " & intSheet _
& " werden bearbeitet"
With ActiveSheet
.Range("A6:A1000").TextToColumns Destination:=.Range("A6"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False
End With
Next wsSheet
Application.ScreenUpdating = True
Application.StatusBar = "Fertig"
End Sub
[/Code]
Gruß Maggi71