VBA Code verkürzen

Guten Tag,
kann man diesen Code verkürzen und die geöffnete Dateien gleich schliessen lassen?
Ausgeführt wird der Code über eine Schaltfläche:

Sub Test()
Sheets("Tabelle1").Select
Sheets("Tabelle1").Name = "WH25"
Range("B36").Select
Workbooks.OpenText Filename:="L:\Büro\Allgemein\Datei Txt\freie Lagerplätze WH25.txt",  _
Origin:=xlWindows, _
StartRow:=9, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(10 _
, 1)), TrailingMinusNumbers:=True
Columns("A:B").Select
Selection.Copy
Windows("Anzahl Neu.xlsb").Activate
Range("A1").Select
ActiveSheet.Paste
Range("D11").Select
Sheets("Tabelle2").Select
Sheets("Tabelle2").Name = "GD65"
Range("C34").Select
Workbooks.OpenText Filename:="L:\Büro\Allgemein\Datei Txt\freie Lagerplätze GD65.txt",  _
Origin:=xlWindows, _
StartRow:=7, 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), Array(5, 1)), TrailingMinusNumbers:=True
Columns("A:C").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Anzahl Neu.xlsb").Activate
Range("A1").Select
ActiveSheet.Paste
Range("G12").Select
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Sheets("Tabelle3").Select
Sheets("Tabelle3").Name = "RB umwandeln"
Range("C30").Select
ChDir "L:\Büro\Allgemein\WE"
Workbooks.Open Filename:= _
"G:\Transfer\Allgemein\WE\Makro frei Lagerplätze.xlsb"
Sheets("RB umwandeln").Select
Columns("A:B").Select
Range("A166").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("Anzahl Neu.xlsb").Activate
Range("A1").Select
ActiveSheet.Paste
Range("D13").Select
Sheets("Tabelle4").Select
Sheets("Tabelle4").Name = "belegte Lagerplätze"
Range("D39").Select
Application.CutCopyMode = False
Workbooks.Open Filename:= _
"L:\Büro\Allgemein\WE\Makro frei Lagerplätze.xlsb"
ActiveWindow.SmallScroll Down:=-15
Sheets("belegte Lagerplätze").Select
ActiveWindow.SmallScroll Down:=-144
Columns("A:B").Select
Selection.Copy
Windows("Anzahl Neu.xlsb").Activate
Range("A1").Select
ActiveSheet.Paste
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D11").Select
Sheets("GD65").Select
Sheets("Tabelle5").Select
Sheets("Tabelle5").Name = "Maße Rollregal"
Workbooks.Open Filename:= _
"L:\Büro\Allgemein\WE\Makro frei Lagerplätze.xlsb"
Sheets("Maße Rollregal").Select
Columns("A:C").Select
Selection.Copy
Windows("Anzahl Neu.xlsb").Activate
Range("H41").Select
Sheets("Maße Rollregal").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Tabelle6").Select
Sheets.Add
Sheets("Tabelle1").Select
Sheets("Tabelle1").Name = "Auswertung"
Range("G37").Select
Sheets("Auswertung").Select
Range("D11").Select
End Sub

Habt ihr eine Idee?
Vielen lieben Dank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
ja und?
dafür gibt es ja diese Anleitungen im Internet, wo man nachlesen kann wie man es machen muss.
Wenn es da schon steht, ist es ja nicht notwendig, dass es jemand anderes nochmal hin schreibt.
im Prinzip ist es nichst anderes, als das du das Selektieren und aktivieren weglässt und stattdessen die Zellbezüge immer vollständig angbist, mit Workbook(...).Worksheet(...).Range(...)
dh aus

Columns("A:B").Select
Selection.Copy
Windows("Anzahl Neu.xlsb").Activate
Range("A1").Select
ActiveSheet.Paste

macht man

Columns("A:B").Copy
Workbooks("Anzahl Neu.xlsb").Sheets("Tabelle1").Range("A1").PasteSpecial xlpasteall

Wenn man den Code dann so verkürzt hat, fallem einem dann auch oft schnell weitere Verbesserungsmöglichkeiten auf, weil der Code so übersichtlicher ist.
um Dateien zu schließen, gibt es den Close-befehl:

Workbooks("Dateiname.xlsx").Close

wenn du an der Datei was verändert hast, aber diese Änderung nicht speichern willst und auch nicht gefragt werden willsst, verwende

Workbooks("Dateiname.xlsx").Close False

Gruß Daniel

Sub Deklariert() Dim wbQuelle As Workbook, wbZiel As Workbook Dim wsQuelle As Worksheet, wsZiel As Worksheet Dim rngQuelle As Range, rngZiel As Range Set wbQuelle = Workbooks.Open(Filename:= _ "L:\Büro\Allgemein\WE\Makro frei Lagerplätze.xlsb") Set wsQuelle = wbQuelle.Worksheets("belegte Lagerplätze") Set rngQuelle = wsQuelle.Range("A:C") Set wbZiel = Workbooks("Anzahl.xlsb") Set wsZiel = wbZiel.Worksheets("belegte Lagerplätze") Set rngZiel = wsQuelle.Range("A1") rngQuelle.Copy Destination:=rngZiel Application.CutCopyMode = False wbQuelle.Close False Set rngQuelle = Nothing: Set rngZiel = Nothing Set wsQuelle = Nothing: Set wsZiel = Nothing Set wbQuelle = Nothing: Set wbZiel = Nothing End Sub

Sub Deklariert() Dim wbQuelle As Workbook, wbZiel As Workbook Dim wsQuelle As Worksheet, wsZiel As Worksheet Dim rngQuelle As Range, rngZiel As Range Set wbQuelle = Workbooks.Open(Filename:= _ "L:\Büro\Allgemein\WE\Makro frei Lagerplätze.xlsb") Set wsQuelle = wbQuelle.Worksheets("belegte Lagerplätze") Set rngQuelle = wsQuelle.Range("A:C") Set wbZiel = Workbooks("Anzahl.xlsb") Set wsZiel = wbZiel.Worksheets("belegte Lagerplätze") Set rngZiel = wsZiel.Range("A1") rngQuelle.Copy Destination:=rngZiel Application.CutCopyMode = False wbQuelle.Close False Set rngQuelle = Nothing: Set rngZiel = Nothing Set wsQuelle = Nothing: Set wsZiel = Nothing Set wbQuelle = Nothing: Set wbZiel = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread