ich habe in einem Datenblatt eine Tabelle(A3:AD100) mit Daten.
Diese Daten möchte ich mit einem Makro löschen und dann mit einer Textdatei, die durch Semikolons getrennt ist, wieder füllen.
Wie kann ich das machen?
Gruss Jens
Sub prcGet_Data_from_Text_File()
Dim wksZiel As Worksheet
Dim varText, wkbText As Workbook, wksText As Worksheet
varText = Application.GetOpenFilename("Textfile (*.txt),*.txt", _
Title:="Bitte zu importierende Textdatei auswählen", _
MultiSelect:=False)
If varText = False Then Exit Sub
Set wksZiel = ActiveSheet
Application.ScreenUpdating = False
Application.Workbooks.OpenText Filename:=varText, _
Startrow:=1, _
DataType:=xlDelimited, _
Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False, _
local:=True
Set wkbText = Application.Workbooks(Mid(varText, InStrRev(varText, "\") + 1))
Set wksText = wkbText.Sheets(1)
wksZiel.Range("A3:AD100").ClearContents
With wksText
.Range(.Cells(1, 1), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, 30)).Copy
End With
wksZiel.Range("A3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
wkbText.Close savechanges:=False
Range("A3").Select
Application.ScreenUpdating = True
End Sub
Sub prcGet_Data_from_Text_File()
Dim wksZiel As Worksheet
Dim varText, wkbText As Workbook, wksText As Worksheet
varText = "C:\users\Public\Test\SAP_Testdata.txt"
If Dir(varText) = "" Then
MsgBox "Datei" & vbLf & varText & vbLf & "nicht gefunden!"
Exit Sub
End If
Set wksZiel = ActiveSheet
Application.ScreenUpdating = False
Application.Workbooks.OpenText Filename:=varText, _
Startrow:=1, _
DataType:=xlDelimited, _
Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False, _
local:=True
Set wkbText = Application.Workbooks(Mid(varText, InStrRev(varText, "\") + 1))
Set wksText = wkbText.Sheets(1)
wksZiel.Range("A3:AD100").ClearContents
With wksText
.Range(.Cells(1, 1), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, 30)).Copy
End With
wksZiel.Range("A3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
wkbText.Close savechanges:=False
Range("A3").Select
Application.ScreenUpdating = True
End Sub