VBA hilfe

Forumthread: VBA hilfe

VBA hilfe

14.11.2022 14:05:25

Klaus

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

5
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

AW: VBA hilfe

14.11.2022 14:11:22

Oberschlumpf

Hi Klaus
mit ner Bsp-Datei von dir, die deinen Code enthält, würd es zumindest mir mehr Spaß machen, versuchen zu helfen.
Ciao
Thorsten

AW: VBA hilfe

14.11.2022 14:12:43

Klaus

Hallo Thorsten,
leider DARF ich die Datei nicht in der Arbeit hochladen. SORRY :-(

AW: VBA hilfe

14.11.2022 14:14:31

Oberschlumpf

Hi Klaus
dann will auch ich dich nich vom Arbeiten abhalten ;-)
Ciao
Thorsten

AW: VBA hilfe

14.11.2022 14:25:17

Rudi

Hallo,
teste mal:


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

Gruß
Rudi

AW: VBA hilfe

14.11.2022 14:42:56

Nepumuk

Hallo Klaus,
teste mal:


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

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Forumthread: VBA hilfe

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

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread