Option Explicit
Private Sub Workbook_Open()
Call Bedarfsverursacher_ermitteln
Call Dateien_verschieben
End Sub
----------------Modul1------------------------------------------------------------
Sub Bedarfsverursacher_ermitteln()
Dim Zielarbeitsmappe As Object
Dim Quellenarbeitsmappe As Object
Dim Sheet As Worksheet
Dim Pfad As String
Dim Datei As String
Dim SaveName As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Zielarbeitsmappe = ActiveWorkbook
Pfad = Environ("Userprofile") & "\Desktop\Makro\Sven\"
Datei = Dir(CStr(Pfad & "*.csv"))
If Dir(Pfad & Datei) = "" Then
MsgBox "Hey Sven, leider habe ich keine Datei in dem Ordner gefunden"
Exit Sub
End If
Do While Datei <> ""
Set Quellenarbeitsmappe = Workbooks.Open(Pfad & Datei, False, True)
Quellenarbeitsmappe.Sheets().Copy After:=Zielarbeitsmappe.Sheets(Zielarbeitsmappe.Sheets.Count)
Zielarbeitsmappe.Sheets(Zielarbeitsmappe.Sheets.Count).Name = Datei
Quellenarbeitsmappe.Close
Datei = Dir()
Loop
For Each Sheet In ActiveWorkbook.Worksheets
If Sheet.Name = "Tabelle1" Then
Application.DisplayAlerts = False
Sheet.Delete
Application.DisplayAlerts = True
End If
Next Sheet
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Columns("D:D").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlFixedWidth, _
OtherChar:="|", FieldInfo:=Array(Array(0, 1), Array(21, 1), Array(48, 1)), _
TrailingMinusNumbers:=True
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("D:D").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Range("N2").Select
Selection.FormulaArray = _
"=IF(ROW()=1,""0"",(IF(R[-1]C=""Achtung"",""Achtung"",(IF(AND(RC[-13]=1),""Achtung"",(IF(OR(LEFT(RC[-13],8)=""Plancode"",LEFT(RC[-13],5)=""Ebene"",LEFT(RC[-12],2)="" +""),ROW(),""0"")))))))"
Selection.AutoFill Destination:=Range("N2:N771"), Type:=xlFillDefault
Range("N2:N771").Select
Columns("A:N").Select
ActiveSheet.Range("$A$1:$N$771").RemoveDuplicates Columns:=14, Header:=xlNo
Rows("1:2").Select
Selection.ClearContents
Selection.Delete Shift:=xlUp
Columns("D:D").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=WENN(LINKS(D1|15)=""EINSCHUBEINHEIT""|WAHR|FALSCH)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
End With
Selection.FormatConditions(1).StopIfTrue = False
Columns("E:E").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=WENN(LINKS(E1|10)=""Bestellung""|WAHR|FALSCH)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5263615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Columns("G:G").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=WENN(ODER(TEIL(G1|4|1)=""S""|(TEIL(G1|4|1)=""A""))|WAHR|FALSCH)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A2:M2").Select
Selection.AutoFilter
Columns("N:N").Select
Selection.ClearContents
Range("P11").Select
Range("M1").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-12],9)"
Range("M2").Select
SaveName = ActiveSheet.Range("M1").Text
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Environ("USERPROFILE") & "\Desktop\Bedarfsverursacher" & SaveName & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Die CSV-Datei der Bedarfsverursacher wurde erfolgreich in eine .xlsx umgewandelt und vorgefiltert!"
Set Zielarbeitsmappe = Nothing
Set Quellenarbeitsmappe = Nothing
End Sub
-----------------------------Modul2---Csv Datei in Ordner "importiert" verschieben---------------------------------------
Public Sub Dateien_verschieben()
Dim strQuelle As String
Dim strZiel As String
Dim objFSO As Object
strQuelle = Environ("Userprofile") & "\Desktop\Makro\Sven\*.csv"
If Dir(strQuelle) = "" Then
Exit Sub
End If
strZiel = Environ("Userprofile") & "\Desktop\Makro\Sven\Importiert"
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.MoveFile strQuelle, strZiel
Set objFSO = Nothing
MsgBox "Die Ausgangsdatei wurde in den Ordner 'Importiert' verschoben"
End Sub