Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1484to1488
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Code verbessern / fehler

Code verbessern / fehler
30.03.2016 13:43:38
Gudrun
Hallo meine Lieben,
kann mir jemand den Code verkleinern und den fehler beseitigen:
Sub LagerplatzkapazitätN()
' Makro1 Makro
ChDir "L:\Tra\All\Datei Txt"
Workbooks.OpenText Filename:= _
"G:\Transfer\Allgemein\Datei Txt\Platzkapazität GD16 Rollregal.txt", Origin:= _
xlWindows, StartRow:=6, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=True, OtherChar:=";", FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
True
Columns("A:C").Select
Selection.Copy
Windows("Nachschub Rollregal.xlsm").Activate
Sheets("Tabelle1").Select
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Platzkapazität GD16 Rollregal.txt").Activate
ActiveWindow.Close
Workbooks.OpenText Filename:= _
"L:\Tra\All\Datei Txt\Platzkapazität GD16 Reserve.txt", Origin:= _
xlWindows, StartRow:=6, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=True, OtherChar:=";", FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
True
Columns("A:C").Select
Selection.Copy
Windows("Nachschub Rollregal.xlsm").Activate
Sheets("Tabelle2").Select
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Platzkapazität GD16 Reserve.txt").Activate
ActiveWindow.Close
Sheets("Tabelle2").Select
Sheets("Tabelle2").Name = "Reserve"
Sheets("Tabelle1").Select
Sheets("Tabelle1").Name = "Rollregal"
Range("G20").Select
ActiveWindow.SmallScroll Down:=-15
Range("E1").Select
End Sub
Zwar kommt immer die MEldung: "Es befindet sich eine große Menge von Informationen in der Zwischenablage........"
Kann man das irgendwie umgehen, aber die Listen sollen geschlossen (Platzkapazität GD16 Reserve.txt und die Platzkapazität GD16 Rollregal .txt )werden.
Kann mir jemand helfen, leider bin ich in VBA weng planlos
Danke
Gudrun

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code verbessern / fehler
30.03.2016 13:56:37
UweD
Hallo
auf select und activate kann meistens verzichtet werden...
ungeprüft....

Sub LagerplatzkapazitätN()
Application.ScreenUpdating = False
Workbooks.OpenText Filename:= _
"G:\Transfer\Allgemein\Datei Txt\Platzkapazität GD16 Rollregal.txt", Origin:= _
xlWindows, StartRow:=6, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=True, OtherChar:=";", FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
True
ActiveSheet.Columns("A:C").Copy
Windows("Nachschub Rollregal.xlsm").Sheets("Tabelle1").Columns("A:A").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Windows("Platzkapazität GD16 Rollregal.txt").Close
Workbooks.OpenText Filename:= _
"L:\Tra\All\Datei Txt\Platzkapazität GD16 Reserve.txt", Origin:= _
xlWindows, StartRow:=6, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=True, OtherChar:=";", FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
True
ActiveSheet.Columns("A:C").Copy
Windows("Nachschub Rollregal.xlsm").Sheets("Tabelle2").Columns("A:A").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Windows("Platzkapazität GD16 Reserve.txt").Close
Sheets("Tabelle2").Name = "Reserve"
Sheets("Tabelle1").Name = "Rollregal"
End Sub
Gruß UweD

Anzeige
AW: Code verbessern / fehler
30.03.2016 14:21:30
Gudrun
Hallo Uwe
Danke
aber leider wird der Code beigelb ( Fehlermeldung)
Windows("Nachschub Rollregal.xlsm").Sheets("Tabelle1").Columns("A:A").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

AW: Code verbessern / fehler
30.03.2016 15:25:59
UweD
Ok
ich hab mal das zuweisen der Dateien verbessert.

Sub LagerplatzkapazitätN()
On Error GoTo Fehler
Dim WB1, WB2
Application.ScreenUpdating = False
Set WB1 = Workbooks("Nachschub Rollregal.xlsm")
Workbooks.OpenText Filename:= _
"G:\Transfer\Allgemein\Datei Txt\Platzkapazität GD16 Rollregal.txt", Origin:= _
xlWindows, StartRow:=6, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=True, OtherChar:=";", FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
True
Set WB2 = ActiveWorkbook
WB2.ActiveSheet.Columns("A:C").Copy
WB1.Sheets("Tabelle1").Columns("A:A").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.DisplayAlerts = False ' Hinweis Zwischenablage unterdrücken
WB2.Close False
Application.DisplayAlerts = True
Workbooks.OpenText Filename:= _
"L:\Tra\All\Datei Txt\Platzkapazität GD16 Reserve.txt", Origin:= _
xlWindows, StartRow:=6, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=True, OtherChar:=";", FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
True
Set WB2 = ActiveWorkbook
WB2.ActiveSheet.Columns("A:C").Copy
WB1.Sheets("Tabelle2").Columns("A:A").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Application.DisplayAlerts = False
WB2.Close False
Application.DisplayAlerts = True
WB1.Sheets("Tabelle2").Name = "Reserve"
WB1.Sheets("Tabelle1").Name = "Rollregal"
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
Err.Clear
Application.DisplayAlerts = True
End Sub
Gruß UweD

Anzeige
Danke klappt super :-)
31.03.2016 11:59:26
Gudrun
,

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige