ich habe heute ein Problem das mit der geschwindigkeit meines Makros zu tun hat ....
ich habe hier ein Makro das mir von einer datei in die andere Daten überträgt.
Aber leider braucht das makro sehr lange :(
Es ist sehr viel Code aber ich hoffe ihr habt vielleicht trotzdem tipps für mich.
Wäre wirklich super.
Noch eine info ..
ganz oben bei dem Aufruf der eizelnen makros steht also habe ich eingetragen ..
"Application.ScreenUpdating = False"
aber das hilft nicht besonders viel.
Danke gruß Christian
Public old_wb
Sub uebertrag_L5_1(x, s, f)
Set old_wb = ActiveWorkbook
'öffnet MAE
Workbooks.Open ("Runden 5.1.xls")
Set new_wb = ActiveWorkbook
akt_sheet_name_monat = MonthName(Month(datum.Calendar1.Value))
new_wb.Worksheets(akt_sheet_name_monat).Select
'suchen Spalte mit akt Datum neue Mappe
For xx = 4 To 200
If Cells(6, xx) = datum.Calendar1.Value Then
Exit For
Else
End If
Next
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 1
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(20, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(20, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(20, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 8
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(176, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(176, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(176, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 12
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(173, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(173, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(173, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 13
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(175, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(175, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(175, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 15
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(177, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(177, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(177, xx + 1) = "1"
Else
End If
'ActiveWorkbook.Close False
End Sub
'-------------------------------------- ENDE 5_1 -----------------------------------------
'-------------------------------------- ENDE 5_1 -----------------------------------------
Sub uebertrag_L5_2(x, s, f)
'Set old_wb = ActiveWorkbook
'öffnet MAE
Workbooks.Open ("Runden 5.2.xls")
Set new_wb = ActiveWorkbook
akt_sheet_name_monat = MonthName(Month(datum.Calendar1.Value))
new_wb.Worksheets(akt_sheet_name_monat).Select
'suchen Spalte mit akt Datum neue Mappe
For xx = 4 To 200
If Cells(6, xx) = datum.Calendar1.Value Then
Exit For
Else
End If
Next
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 1
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(20, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(20, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(20, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 8
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(176, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(176, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(176, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 12
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(173, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(173, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(173, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 13
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(175, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(175, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(175, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 15
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(177, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(177, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(177, xx + 1) = "1"
Else
End If
'ActiveWorkbook.Close False
End Sub
'-------------------------------------- ENDE 5_2 -----------------------------------------
'-------------------------------------- ENDE 5_2 -----------------------------------------
Sub uebertrag_L5_3(x, s, f)
'Set old_wb = ActiveWorkbook
'öffnet MAE
Workbooks.Open ("Runden 5.3.xls")
Set new_wb = ActiveWorkbook
akt_sheet_name_monat = MonthName(Month(datum.Calendar1.Value))
new_wb.Worksheets(akt_sheet_name_monat).Select
'suchen Spalte mit akt Datum neue Mappe
For xx = 4 To 200
If Cells(6, xx) = datum.Calendar1.Value Then
Exit For
Else
End If
Next
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 1
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(20, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(20, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(20, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 8
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(176, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(176, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(176, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 12
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(173, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(173, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(173, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 13
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(175, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(175, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(175, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 15
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(177, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(177, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(177, xx + 1) = "1"
Else
End If
'ActiveWorkbook.Close False
End Sub
'-------------------------------------- ENDE 5_3 -----------------------------------------
'-------------------------------------- ENDE 5_3 -----------------------------------------
Sub uebertrag_L5_4(x, s, f)
'Set old_wb = ActiveWorkbook
'öffnet MAE
Workbooks.Open ("Runden 5.4.xls")
Set new_wb = ActiveWorkbook
akt_sheet_name_monat = MonthName(Month(datum.Calendar1.Value))
new_wb.Worksheets(akt_sheet_name_monat).Select
'suchen Spalte mit akt Datum neue Mappe
For xx = 4 To 200
If Cells(6, xx) = datum.Calendar1.Value Then
Exit For
Else
End If
Next
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 1
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(20, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(20, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(20, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 8
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(176, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(176, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(176, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 12
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(173, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(173, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(173, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 13
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(175, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(175, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(175, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 15
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(177, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(177, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(177, xx + 1) = "1"
Else
End If
'ActiveWorkbook.Close False
End Sub
'-------------------------------------- ENDE 5_4 -----------------------------------------
'-------------------------------------- ENDE 5_4 -----------------------------------------
Sub uebertrag_L5_5(x, s, f)
'Set old_wb = ActiveWorkbook
'öffnet MAE
Workbooks.Open ("Runden 5.5.xls")
Set new_wb = ActiveWorkbook
akt_sheet_name_monat = MonthName(Month(datum.Calendar1.Value))
new_wb.Worksheets(akt_sheet_name_monat).Select
'suchen Spalte mit akt Datum neue Mappe
For xx = 4 To 200
If Cells(6, xx) = datum.Calendar1.Value Then
Exit For
Else
End If
Next
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 1
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(20, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(20, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(20, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 8
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(176, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(176, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(176, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 12
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(173, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(173, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(173, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 13
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(175, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(175, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(175, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 15
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(177, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(177, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(177, xx + 1) = "1"
Else
End If
'ActiveWorkbook.Close False
End Sub
'-------------------------------------- ENDE 5_5 -----------------------------------------
'-------------------------------------- ENDE 5_5 -----------------------------------------
Sub uebertrag_L5_6(x, s, f)
'Set old_wb = ActiveWorkbook
'öffnet MAE
Workbooks.Open ("Runden 5.6.xls")
Set new_wb = ActiveWorkbook
akt_sheet_name_monat = MonthName(Month(datum.Calendar1.Value))
new_wb.Worksheets(akt_sheet_name_monat).Select
'suchen Spalte mit akt Datum neue Mappe
For xx = 4 To 200
If Cells(6, xx) = datum.Calendar1.Value Then
Exit For
Else
End If
Next
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 1
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(20, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(20, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(20, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(20, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 8
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(176, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(176, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(176, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(176, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 12
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(173, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(173, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(173, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(173, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 13
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(175, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(175, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(175, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(175, xx + 1) = "1"
Else
End If
tx = old_wb.ActiveSheet.Range("sp5_1").Row + 15
If old_wb.ActiveSheet.Cells(tx, x) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx + s) = old_wb.ActiveSheet.Cells(tx, x) * 60 '
new_wb.ActiveSheet.Cells(177, xx + s + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 1) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx + f) = old_wb.ActiveSheet.Cells(tx, x + 1) * 60 '
new_wb.ActiveSheet.Cells(177, xx + f + 1) = "1"
Else
End If
If old_wb.ActiveSheet.Cells(tx, x + 2) * 60 > 0 Then
new_wb.ActiveSheet.Cells(177, xx) = old_wb.ActiveSheet.Cells(tx, x + 2) * 60 '
new_wb.ActiveSheet.Cells(177, xx + 1) = "1"
Else
End If
'ActiveWorkbook.Close False
End Sub
'-------------------------------------- ENDE 5_6 -----------------------------------------
'-------------------------------------- ENDE 5_6 -----------------------------------------