VBA hilfe

Hallo zusammen,
kann man diesen Code kleiner machen ? und kann man diesen Fehler von der Datei entnehmen ( Daten xls soll geschlossen werden ), ob diese zwischendatei gespeichert wird.
Danke an alle


Sub Makro5()
' Makro5 Makro
Workbooks.Open Filename:="L:\F\Daten.xls"
Cells.Select
Selection.Copy
Windows("Grunddatei.xlsb").Activate
Sheets("Eingabe").Select
Range("A1").Select
ActiveSheet.Paste
Range("E18").Select
Windows("Daten.xls").Activate
ActiveWindow.Close
Sheets("Eingabe").Select
Columns("E:E").Select
Selection.Copy
Sheets("Auswertung").Select
Columns("A:A").Select
ActiveSheet.Paste
Columns("A:A").Select
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$9243").RemoveDuplicates Columns:=1, Header:=xlNo
Columns("A:C").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("B6").Select
Columns("A:A").EntireColumn.AutoFit
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA hilfe

14.11.2022 14:11:22

Oberschlumpf

AW: VBA hilfe

14.11.2022 14:12:43

Klaus

AW: VBA hilfe

14.11.2022 14:14:31

Oberschlumpf

AW: VBA hilfe

14.11.2022 14:25:17

Rudi

AW: VBA hilfe

14.11.2022 14:42:56

Nepumuk

Sub Makro5() Workbooks.Open Filename:="L:\F\Daten.xls" Cells.Copy Workbooks("Grunddatei.xlsb").Sheets("Eingabe").Range("A1") Workbooks("Daten.xls").Close False Sheets("Eingabe").Columns("E:E").Copy Sheets("Auswertung").Range("A1") With Sheets("Auswertung") .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo With .Columns("A:C") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With .Columns("A:A").EntireColumn.AutoFit End With End With End Sub

Public Sub Makro5() Dim objWorkbook As Workbook Set objWorkbook = Workbooks.Open(Filename:="L:\F\Daten.xls") Call objWorkbook.Worksheets(1).Cells.Copy(Destination:=ThisWorkbook.Worksheets("Eingabe").Cells(1, 1)) Call objWorkbook.Close(SaveChanges:=False) Set objWorkbook = Nothing Call ThisWorkbook.Worksheets("Eingabe").Columns(5).Copy(Destination:=Worksheets("Auswertung").Cells(1, 1)) Call Worksheets("Auswertung").Columns(1).RemoveDuplicates(Columns:=1, Header:=xlNo) Worksheets("Auswertung").Columns("A:C").Borders.Weight = xlThin Call Worksheets("Auswertung").Columns(1).AutoFit End Sub

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread