Laufzeitfehler 1004

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Das makro läuft manuell.
Sub txt_importieren()
' Erstellt unter EXCEL2003
' Import einer txt-Dateie in eine EXCEL-Arbeitsmappe
Dim wbCSV As Workbook, wbDatei As Workbook, Blattname As String
Dim strPath As String, BoxTitel As String, BoxPrompt As String
Dim strFilename As String, NameAnfang As String
Dim Farbe As String, I As Integer
Dim Zelle As Range
Dim Bereich0 As Range
Dim Bereich As Range
Dim Blatt As Worksheet
Dim PosNr As String
BoxTitel = "txt-Dateien laden"
strPath = InputBox("Pfad der txt-Dateien", BoxTitel, "C:\temp")
If strPath = "" Then Exit Sub
NameAnfang = InputBox("Name der gesuchten txt-Datei:", BoxTitel, "stueckliste")
If NameAnfang = "" Then Exit Sub
'txt-Dateien laden
'
strFilename = strPath & "\" & NameAnfang & "*.txt"
Workbooks.OpenText strFilename, Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False, _
Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 2), Array(4, 1), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), _
Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15 _
, 2)), TrailingMinusNumbers:=True
' PosNrBereinigen
ActiveCell.Replace What:=" PosNr ", Replacement:= _
"PosNr", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Cells.Find(What:=" PosNr ", After:=ActiveCell, LookIn _
:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
' LeerzeichenAusTextLoeschen
'Dim C As Range
'For Each C In ActiveSheet.UsedRange
'C = WorksheetFunction.Trim(C)
'Next C
' PosNr finden
Cells.Find(What:="PosNr", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
'BereichMarkierenRelativ()
'Worksheets("stueckliste").Activate
Range(ActiveCell(), ActiveCell.Offset(1000, 12)).Select
Set Bereich = Selection
'selection copy
Bereich.Copy
'Musterstueckliste oeffnen
Windows("Stueckliste_Makro_2006_05_03_Faktor_gueltig.xls").Activate
Range("B1").Select
Selection.PasteSpecial
' LeerzeichenAusZelleEntfernen()
' Dim s As String
' Dim Zelle As Range
Sheets("Stueckliste").Activate
For Each Zelle In Selection
s = Application.Substitute(Zelle, " ", "")
Zelle.Value = s
Next Zelle
End Sub
nur unter dem


Private Sub CommandButton5_Click()
End Sub

bekomme ich eine Fehlermeldung.
in meiner Stueckliste.txt steht:
https://www.herber.de/bbs/user/35022.txt
Bitte um hilfe
Gruss Carsten

Sub ZellenTrim() Dim rngbereich As Range Dim rngCell As Range Set rngbereich = ActiveSheet.UsedRange For Each rngCell In rngbereich If Left(rngCell, 1) = " " Then rngCell = WorksheetFunction.Trim(rngCell) End If Next End Sub

Beliebteste Forumthreads (12 Monate)

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread