AW: Makro das Zeilen mit fortlaufendem Datum kopiert
16.12.2015 13:41:51
Mario
Hi,
alles klar. Danke dir vielmals! :)
Dann werde ich es mit 2 Tabellenblättern beibehalten.
Vll kannst du mir bei folgendem Problem auch noch weiterhelfen:
Und zwar habe ich ein Makro, dass die Güter der Einzelliste aus einem anderen Tabellenblatt ("Verbindlichkeiten") nach Capex übernimmt. Im Blatt Capex sind Formeln zur Berechnung der Abschreibungsraten und zur Berechnung des Enddatums etc vorhanden. Das besagte Makro überschreibt diese dann aber leider mit einem leeren Feld (wenn das Feld in der Ursprungstabelle "Verbindlichkeiten" leer stand) sodass keine Formeln mehr enthalten sind. Kann man folgendes Makro evtl. so umschreiben, dass die Formeln im Blatt "Capex" erhalten bleiben. Das wär echt super:)
Hier noch der Code von besagtem Makro:
Private Sub CommandButton5_Click()
CommandButton5.Caption = "CAPEX ausbuchen"
Dim rng As Range
Dim lngNext As Long, lngR As Long
Dim CalculationMode As Long
Const cstrView As String = "tempView"
On Error GoTo ErrorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
CalculationMode = .Calculation
.Calculation = xlManual
.DisplayAlerts = False
End With
ThisWorkbook.CustomViews.Add cstrView, True, True
With Sheets("Verbindlichkeiten").Range("A7").CurrentRegion
.AutoFilter
.AutoFilter Field:=12, Criteria1:="=CAPEX"
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells( _
xlCellTypeVisible)
On Error GoTo 0
End With
If Not rng Is Nothing Then
With Sheets("CAPEX")
lngNext = Application.Max(8, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
rng.Copy .Cells(lngNext, 1)
For lngR = lngNext To Application.Max(lngNext, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
.Cells(lngR, 15) = .Cells(lngR, 5).Value: .Cells(lngR, 5) = ""
.Cells(lngR, 14) = .Cells(lngR, 6).Value: .Cells(lngR, 6) = ""
Next
rng.Delete
End With
End If
Sheets("Verbindlichkeiten").Range("A7").CurrentRegion.AutoFilter
With ThisWorkbook
.CustomViews(cstrView).Show
.CustomViews(cstrView).Delete
End With
ErrorHandler:
With Err
If .Number 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'nn'" & vbLf & String(25, "") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, 81968, "VBA - Fehler in Prozedur - capex", .HelpFile, .HelpContext
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalculationMode
.DisplayAlerts = True
.StatusBar = False
End With
End Sub
Grüße und Vielen Dank im Voraus
Mario