VBA Importieren
12.08.2022 09:38:35
Müller
leider habe ich ein kleines problem.
Wir spielen Daten von einem Programm ins Excel QS.xls. Leider habe ich nur diese Auswahl.
Anschließend habe ich diesen Code erstellt:
Durch einen Button im Excel Schnellzugriff greife ich zu diesem Code
Ich möchte das diese Daten erstmal vom Xls in einer neuen Datei gespeichert wird das es dann anschließend die Datei in einem Ordner speichert.
Wenn ich die gespeicherte Datei aufmache kommt eine Fehlermedung:
Die Datei 12.08...... kann von Excel nicht geöffnet werden, da das Dateiformat ungültig ist. Überprüfen Sie , ob die Datei beschädigt ist und ob die Dateierweiterung dem Dateiformat entspricht
- Kann man xls lassen ?
- die Datei QS.xls soll danach geschlossen werden und nicht gespeichert werden, da es nur als zwischenspeicher benutzt wird.
Sub QS()
' Makro1 Makro
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\Users\Müller\Desktop\QS.xls"
Range("H29").Select
Workbooks.Add
Windows("QS.xls").Activate
Cells.Select
Selection.Copy
Windows("Mappe1").Activate
Cells.Select
ActiveSheet.Paste
Range("D11").Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Range("D1").Select
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("I:I").EntireColumn.AutoFit
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("J:N").Select
Selection.Delete Shift:=xlToLeft
Columns("K:N").Select
Selection.Delete Shift:=xlToLeft
Columns("L:Q").Select
Selection.Delete Shift:=xlToLeft
Range("N7").Select
Columns("B:B").EntireColumn.AutoFit
Range("D1").Select
ActiveCell.FormulaR1C1 = "Mat"
Range("D2").Select
Columns("D:D").ColumnWidth = 3.71
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
Columns("A:K").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("A1:K1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("F6").Select
Range("A1:K1").AutoFilter
ThisWorkbook.SaveCopyAs "L:\Daten\A\A\Fertig\" & Format(Now, "dd.mm.yyyy hh_mm_ss") & _
".xlsx"
Application.ScreenUpdating = True
MsgBox "Daten wurden Erfolgreich in den Ordner Fertig gespeichert"
End Sub