Hallo,
ich hab ein Problem. Mein Makro funktioniert in der Arbeitsmappe an sich selber so wie es soll.
Zusammengefasst: Bearbeitung vom Dokument und dann eine Speicherung als CSV.
Wenn ich jetzt nun das Makro in die PERSONAL.XLSB schreibe,damit ich es in jeder Arbeitsmappe nutzen kann, dann funktioniert es ncht mehr mit dem Speicherort und dem Dateiname,
weil er ja dann die PERSONAL.XLSB überschreiben möchte......
gibt es hierfür eine Problemlösung:
Sub Materialliste()
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("D:R").Select
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("C:C").Select
ActiveWindow.SmallScroll Down:=-18
Selection.ClearContents
Range("C18").Select
ActiveWindow.SmallScroll Down:=-42
Range("C1").Select
ActiveCell.FormulaR1C1 = "=AUFRUNDEN(B1;1)"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=AUFRUNDEN(B1;0)"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=AUFRUNDEN(B1;0)"
Columns("C:C").ColumnWidth = 14.86
Selection.NumberFormat = "General"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=ROUNDUP(RC[-1],0)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C503"), Type:=xlFillDefault
Range("C1:C503").Select
ActiveWindow.SmallScroll Down:=-513
Dim UG As String
Dim OG As String
UG = "0.1" 'UnterGrenze
OG = "99999999999.9" 'OberGrenze
With Tabelle1.UsedRange 'Tabelle anpassen *****
With .Columns(.Columns.Count).Offset(, 1)
.Formula = "=IF(OR(MIN(RC1:RC[-1])<" & UG & ",MAX(RC1:RC[-1])>" & OG & "),1,"""")"
.Value = .Value
.EntireRow.Sort .Cells(1), xlAscending, Header:=xlNo
On Error Resume Next
.SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete
.ClearContents
On Error GoTo 0
End With
End With
Selection.Copy
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("E12").Select
ActiveWindow.SmallScroll Down:=60
Dim sName As String
sName = Split(ThisWorkbook.FullName, ".")(0)
'
Call ThisWorkbook.SaveAs( _
Filename:=sName, _
FileFormat:=xlCSVMSDOS, _
CreateBackup:=False)
End Sub
Danke, für die Hilfe ! Gruß!
|