hmmm.. ich habe nach bestem Wissen und Gewissen versucht deinen Tipp umzusetzen.. erneut erfolglos
Falls sich jemand erbarmen mag.. folgend der komplette Code
Code:
Sub Auto_open()
Dim dlgOpen As FileDialog
Dim strDatei As String
Dim V_Beleg As String
Dim VDatum As Date
Dim i As Long, j As Long, g As Integer, V_WE As String
Dim V_Quelle As String, V_Ziel As String, V_Makro As String
V_Makro = ActiveWorkbook.Name
MsgBox ("Bitte wählen Sie die zu formatierende Liste aus.")
Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
With dlgOpen
.AllowMultiSelect = False
.Show
On Error Resume Next
strDatei = .SelectedItems(1)
On Error GoTo 0
End With
If strDatei <> "" Then
Workbooks.Open Filename:=strDatei, UpdateLinks:=0
End If
V_Quelle = ActiveWorkbook.Name
Workbooks.Add
V_Ziel = ActiveWorkbook.Name
g = 2
For i = 2 To 50
If (Workbooks(V_Makro).Sheets(1).Cells(i, 1).Value) = (Left(V_Quelle, 4)) Then
V_WE = Workbooks(V_Makro).Sheets(1).Cells(i, 2).Value
End If
Next i
Workbooks(V_Ziel).Sheets(1).Cells(1, 1).Value = "Text1"
Workbooks(V_Ziel).Sheets(1).Cells(1, 2).Value = "Text2"
Workbooks(V_Ziel).Sheets(1).Cells(1, 3).Value = "Text3"
Workbooks(V_Ziel).Sheets(1).Cells(1, 4).Value = "Text4"
Workbooks(V_Ziel).Sheets(1).Cells(1, 5).Value = "Text5"
Workbooks(V_Ziel).Sheets(1).Cells(1, 6).Value = "Text6"
Workbooks(V_Ziel).Sheets(1).Cells(1, 7).Value = "Text7"
Workbooks(V_Ziel).Sheets(1).Cells(1, 8).Value = "Text8"
Workbooks(V_Ziel).Sheets(1).Cells(1, 9).Value = "Text9"
'Aufgliederung nach Fälligkeit (30-60-90)
For i = 2 To 10000
If Workbooks(V_Quelle).Sheets(1).Cells(i, 5).Value <> "" Then
Workbooks(V_Ziel).Sheets(1).Cells(g, 1).Value = Left(V_Quelle, 4)
Workbooks(V_Ziel).Sheets(1).Cells(g, 2).Value = V_WE
Workbooks(V_Ziel).Sheets(1).Cells(g, 3).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 2).Value
Workbooks(V_Ziel).Sheets(1).Cells(g, 4).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 9).Value
Workbooks(V_Ziel).Sheets(1).Cells(g, 20).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 1).Value
Workbooks(V_Ziel).Sheets(1).Cells(g, 5).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value
If (V_Datum - 30 < DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) And DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) < V_Datum) Then
Workbooks(V_Ziel).Sheets(1).Cells(g, 6).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 9).Value
End If
If DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) + 60 > V_Datum And V_Datum >= DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) + 30 Then
Workbooks(V_Ziel).Sheets(1).Cells(g, 7).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 9).Value
End If
If DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) + 90 > V_Datum And V_Datum >= DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) + 60 Then
Workbooks(V_Ziel).Sheets(1).Cells(g, 8).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 9).Value
End If
If V_Datum >= DateValue(Workbooks(V_Quelle).Sheets(1).Cells(i, 7).Value) + 90 Then
Workbooks(V_Ziel).Sheets(1).Cells(g, 9).Value = Workbooks(V_Quelle).Sheets(1).Cells(i, 9).Value
End If
g = g + 1
End If
Next i
Columns("A:H").Select
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range( _
"C2:C453"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Tabelle1").Sort
.SetRange Range("A1:I453")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Belege zusammenfassen
For i = 2 To 3000
If Workbooks(V_Ziel).Sheets(1).Cells(i, 3).Value = Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 3).Value Then
Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 6).Value = Workbooks(V_Ziel).Sheets(1).Cells(i, 6).Value + Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 6).Value
Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 7).Value = Workbooks(V_Ziel).Sheets(1).Cells(i, 7).Value + Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 7).Value
Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 8).Value = Workbooks(V_Ziel).Sheets(1).Cells(i, 8).Value + Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 8).Value
Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 9).Value = Workbooks(V_Ziel).Sheets(1).Cells(i, 9).Value + Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 9).Value
Workbooks(V_Ziel).Sheets(1).Cells(i, 1).EntireRow.Delete Shift:=xlUp
i = i - 1
End If
If Workbooks(V_Ziel).Sheets(1).Cells(i + 1, 1).Value = "" Then
Exit For
End If
Next i
Range("A1:I1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Selection.ColumnWidth = 10.86
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").ColumnWidth = 10.86
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Range("A1:H454").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.14996795556505
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.14996795556505
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.14996795556505
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.14996795556505
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.14996795556505
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.14996795556505
.Weight = xlThin
End With
Range("A1:H1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Cells.Select
With Selection.Font
.Name = "Calibri"
.Size = 6
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("C11").Select
Workbooks(V_Ziel).Activate
Cells.Font.Size = 7
Cells.Font.Name = "Arial"
Workbooks(V_Ziel).Sheets(1).Columns("A:A").ColumnWidth = 3.3
Workbooks(V_Ziel).Sheets(1).Columns("b:b").ColumnWidth = 13.57
Workbooks(V_Ziel).Sheets(1).Columns("c:c").ColumnWidth = 25
Workbooks(V_Ziel).Sheets(1).Columns("d:d").ColumnWidth = 9.43
Workbooks(V_Ziel).Sheets(1).Columns("e:e").ColumnWidth = 7.29
Workbooks(V_Ziel).Sheets(1).Columns("f:f").ColumnWidth = 7.29
Workbooks(V_Ziel).Sheets(1).Columns("g:g").ColumnWidth = 7.29
Workbooks(V_Ziel).Sheets(1).Columns("h:h").ColumnWidth = 7.29
For i = 2 To 200
Workbooks(V_Ziel).Sheets(1).Cells(i, 4).FormulaR1C1 = "=SUM(RC[1]:RC[4])"
Workbooks(V_Ziel).Sheets(1).Cells(i, 4).NumberFormat = "#,##0.00 $"
Workbooks(V_Ziel).Sheets(1).Cells(i, 5).NumberFormat = "#,##0.00 $"
Workbooks(V_Ziel).Sheets(1).Cells(i, 6).NumberFormat = "#,##0.00 $"
Workbooks(V_Ziel).Sheets(1).Cells(i, 7).NumberFormat = "#,##0.00 $"
Workbooks(V_Ziel).Sheets(1).Cells(i, 8).NumberFormat = "#,##0.00 $"
Next i
Columns("A:H").Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub