07.02.2022, 16:43
Hallo Excelgemeide,
hab ein kleines Problem und zwar wenn die Daten ins Blatt Vehrzehr_Jahresübersicht (Spalte A) kopiert werden wir aus meine Datumsformat TT.MM.JJJJ - m.T.JJJJ
wie kann man das umstellen, hab da schon was gelesen aber nix verstanden.
Hilfe wäre toll, ein Danke schon mal im vorab.
Gruß Jürgen
Sub Übertragen()
' Übertragen Makro
A = MsgBox("Bitte prüfen!" & Chr(10) & "ist alles bezahlt und eingetragen?" & Chr(10) & "Tagesblatt wird gespeichert" & Chr(10) & "Programm wird beendet", vbYesNo)
If A = vbNo Then Exit Sub Else
ActiveSheet.Unprotect
Dim lastRow As Long, Aktrow As Long
Application.DisplayAlerts = False
Application.Calculation = xlManual
lastRow = Sheets("Verzehr_Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1
Aktrow = 3
While IsDate(Cells(Aktrow, 10)) 'solange J mit Datum belegt
Cells(Aktrow, 10).Resize(, 68).Copy
Sheets("Verzehr_Jahresübersicht").Cells(lastRow, 1).PasteSpecial Paste:=xlPasteValues
lastRow = lastRow + 1
Aktrow = Aktrow + 1
Wend
Aktrow = 22
While IsDate(Cells(Aktrow, 10)) 'solange J mit Datum belegt
Cells(Aktrow, 10).Resize(, 68).Copy
Sheets("Verzehr_Jahresübersicht").Cells(lastRow, 1).PasteSpecial Paste:=xlPasteValues
lastRow = lastRow + 1
Aktrow = Aktrow + 1
Wend
Range("K3:K20,M3:N20,O3:BV20,K22:K35,M22:N35,O22:BV35").Select
Range("AS22").Activate
Selection.ClearContents
Range("K3").Select
Columns("AS:BV").Select
Selection.EntireColumn.Hidden = True
Columns("O:ar").Select
Selection.EntireColumn.Hidden = False
Range("E34").Select
ActiveCell.FormulaR1C1 = "1"
Range("K3").Select
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
'ActiveSheet.Protect
'Blattschutz setzen
ActiveSheet.Protect
ActiveWorkbook.Save
'Application.Quit
hab ein kleines Problem und zwar wenn die Daten ins Blatt Vehrzehr_Jahresübersicht (Spalte A) kopiert werden wir aus meine Datumsformat TT.MM.JJJJ - m.T.JJJJ
wie kann man das umstellen, hab da schon was gelesen aber nix verstanden.
Hilfe wäre toll, ein Danke schon mal im vorab.
Gruß Jürgen
Sub Übertragen()
' Übertragen Makro
A = MsgBox("Bitte prüfen!" & Chr(10) & "ist alles bezahlt und eingetragen?" & Chr(10) & "Tagesblatt wird gespeichert" & Chr(10) & "Programm wird beendet", vbYesNo)
If A = vbNo Then Exit Sub Else
ActiveSheet.Unprotect
Dim lastRow As Long, Aktrow As Long
Application.DisplayAlerts = False
Application.Calculation = xlManual
lastRow = Sheets("Verzehr_Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1
Aktrow = 3
While IsDate(Cells(Aktrow, 10)) 'solange J mit Datum belegt
Cells(Aktrow, 10).Resize(, 68).Copy
Sheets("Verzehr_Jahresübersicht").Cells(lastRow, 1).PasteSpecial Paste:=xlPasteValues
lastRow = lastRow + 1
Aktrow = Aktrow + 1
Wend
Aktrow = 22
While IsDate(Cells(Aktrow, 10)) 'solange J mit Datum belegt
Cells(Aktrow, 10).Resize(, 68).Copy
Sheets("Verzehr_Jahresübersicht").Cells(lastRow, 1).PasteSpecial Paste:=xlPasteValues
lastRow = lastRow + 1
Aktrow = Aktrow + 1
Wend
Range("K3:K20,M3:N20,O3:BV20,K22:K35,M22:N35,O22:BV35").Select
Range("AS22").Activate
Selection.ClearContents
Range("K3").Select
Columns("AS:BV").Select
Selection.EntireColumn.Hidden = True
Columns("O:ar").Select
Selection.EntireColumn.Hidden = False
Range("E34").Select
ActiveCell.FormulaR1C1 = "1"
Range("K3").Select
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
'ActiveSheet.Protect
'Blattschutz setzen
ActiveSheet.Protect
ActiveWorkbook.Save
'Application.Quit