AW: Alternative für jede 2.Zeile
05.02.2008 14:12:25
fcs
Hallo Anja,
hier noch der Code um eine Zeile einzufügen. Da beim Einfügen Formate und Gültigkeitsprüfung von der vorherigen Zeile übernommen werdne, müssen "nur" die Formeln ergänzt werden.
Für das Übertragen der Daten aus den Tagesblättern in die Monatsübersicht muss man sich ggf. etwas anderes überlegen. Das folgende Makro muss in der Arbeitsmappe mit der Monatsübersicht angelegt werden. Es arbeitet wie folgt:
Monatsübersicht und Datei mit Tagesdaten sind geöffnet.
In der Tagesdatei die Zeilen markieren, die übertragen werden sollen
Jetzt bei aktiver Tagesdatei das Makro in der Monatsdatei starten.
Das Makro prüft ob ausreichend Zeilen mit Formeln vorhanden sind und fügt ggf. Zeilen und Formeln ein.
Anschließend werden aus den im Makro vorgegebenen Spalten die Werte aus der Tages-Datei in die Monatsübersicht übertragen. Zeilen und Spaltennummern muss du ggf. anpassen. Das Ganze kann man noch verfeinern, wenn es darum geht Formeln in der Monatsübersicht durch Werte in der Tagesdatei zu überschreiben.
Gruß
Franz
Sub NeueZeileEinfügen()
Dim lNot As Long, Zelle As Range, ZeileNeu As Long
Application.EnableEvents = False
lNot = 10 'Notzeile mit Formeln
Set Zelle = Cells(ActiveCell.Row, 1)
ZeileNeu = Zelle.Row
Zelle.EntireRow.Insert shift:=xlShiftDown
For Each Zelle In Range(Cells(lNot, 1), Cells(lNot, _
Cells.SpecialCells(xlCellTypeLastCell).Column))
If Zelle.HasFormula = True Then
Cells(ZeileNeu, Zelle.Column).FormulaR1C1 = Zelle.FormulaR1C1
End If
Next
Cells(ZeileNeu, 2).Select
Application.EnableEvents = True
End Sub
Sub vonTag_nach_Monat()
Dim wksMonat As Worksheet, wksTag As Worksheet
Dim Bereich As Range, ZeileMonat As Long, ZeileTag As Long, Spalte As Integer
Dim FormelMonat As Long, zeile As Long, lNot As Long
Set wksTag = ActiveSheet
Set Bereich = Selection
Set wksMonat = ThisWorkbook.Worksheets(5) 'ggf. Nr. anpassen oder "MonatÜbersicht"
lNot = 10 'Zeile mit Notformel in Blatt Monatsübersicht
Application.EnableEvents = False
On Error GoTo Fehlerbehandlung
'Letzte Zeile mit Eingabewert in Monatsübersicht ermitteln
With wksMonat
For Spalte = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Column
Select Case Spalte
Case 2, 3, 5, 6, 8, 9, 11 'Eingabe-Spalten im Blatt Moant
ZeileMonat = Application.WorksheetFunction.Max(ZeileMonat, _
.Cells(.Rows.Count, 2).End(xlUp).Row)
Case Else
'do nothing
End Select
Next
'letzte Zeile mit Formel in Monatsübersicht
FormelMonat = .Cells(.Rows.Count, 4).End(xlUp).Row
'Formeln und Formate für Bereich ggf. in Monatsübersicht einfügen
If FormelMonat - ZeileMonat 0 Then
If Target.Address = .Cells(zeile, i).Address Then
Wert = Target.Value
.Cells(lNot, i).Copy Destination:=.Cells(zeile, i)
.Cells(zeile, i).Value = Wert
Else
.Cells(lNot, i).Copy Destination:=Cells(zeile, i)
.Cells(zeile, i).ClearContents
End If
End If
NextZelle:
Next
Next
.Rows(lNot).Copy
.Range(.Rows(zeileformel + 1), .Rows(ZeileMonat + Bereich.Rows.Count)).PasteSpecial _
Paste:=xlPasteFormats
Application.CutCopyMode = False
End If
'Werte aus Bereich in Tag in Monatsübersicht übertragen
For ZeileTag = Bereich.Row To Bereich.Row + Bereich.Rows.Count - 1
ZeileMonat = ZeileMonat + 1 'nachste Zeile um Werte aus TAg einzutragen
For Spalte = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Column
Select Case Spalte
'Spalten deren Werte von Tag nach Monat übertragen werden sollen
Case 2, 3, 5, 6, 8, 9, 11
.Cells(ZeileMonat, Spalte).Value = wksTag.Cells(ZeileTag, Spalte).Value
Case Else
'do nothing
End Select
Next
Next
End With
Exit Sub
Application.EnableEvents = True
Fehlerbehandlung:
Resume NextZelle
Application.EnableEvents = True
End Sub