Zeilen in Tabelle einfügen

Hallo!
Freud mich das es funktioniert!
Hier der Code, angepasst nach deinen wünschen.

Sub JahreEinfügen()
Dim start As String
Dim ende As String
Dim intC As Integer
Dim rngAdr As Range
'   Do
'   start = InputBox("Bitte geben Sie das Startjahr ein." & vbLf & _
'      "Die Jahreszahl muss vierstellig sein!", "Start", CStr(Year(Date) - 1))
'      If start = "" Then Exit Sub
'      If Not IsNumeric(start) Then start = 0
'   Loop While Len(start) <> 4 Or CInt(start) < 1900 Or CInt(start) > 3999
'   Do
'   ende = InputBox("Bitte geben Sie das Endjahr ein." & vbLf & _
'      "Die Jahreszahl muss vierstellig sein!", "Ende", CStr(Year(Date) - 10))
'      If ende = "" Then Exit Sub
'      If Not IsNumeric(ende) Then ende = 0
'   Loop While Len(ende) <> 4 Or CInt(ende) < 1900 Or CInt(ende) > 3999 Or CInt(ende) >= start
'start = CInt(start)
'ende = CInt(ende)
'##############################################################################
start = Sheets("TabelleMitStartwert").Range("A1") 'Tabelle ung Bereich anpassen
ende = Sheets("TabelleMitEndWert").Range("A1") 'Tabelle ung Bereich anpassen
'##############################################################################
   With Sheets(1) 'Tabelle anpassen
   .Range("A3:B1000").ClearContents
   'Bereich "A2:B1000" löschen
      For intC = 3 To (start - ende) + 3
      .Cells(intC, 1) = (start + 3) - intC
      .Cells(intC, 2).FormulaR1C1 = "=IF(RC[-1]>YEAR(TODAY())-10,""X"","""")"
      'Formel für Spalte "B" nur als Beispiel
      'Für Deine Formel am besten den Makrorekorder benutzen!
      Next
      '#######################################################################
      'Ich nehme an, das Die Formel für die Summe unter die Zellen mit
      'deinen Berechnungen soll, sonst Zeile bzw. Spalte anpassen
      Set rngAdr = Range(.Cells(3, 2), .Cells(intC - 1, 2))
      'Adresse des Bereichs ermitteln
      .Cells(intC, 2).FormulaLocal = "=SUMME(" & rngAdr.Address & ")"
      'oder
      .Cells(intC, 3).Value = WorksheetFunction.Sum(strAdr)
      'oder
      .Range("D5").Value = WorksheetFunction.Sum(strAdr)
      'jenachdem wo die Summe stehen sol
      '#######################################################################
   End With
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Gruß Sepp

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi,
so ganz verstehe ich nicht was Du willst, aber
ein Makro als versuch.

Sub JahreEinfügen()
Dim start As String
Dim ende As String
Dim intC As Integer
   Do
   start = InputBox("Bitte geben Sie das Startjahr ein." & vbLf & _
      "Die Jahreszahl muss vierstellig sein!", "Start", CStr(Year(Date)))
      If start = "" Then Exit Sub
      If Not IsNumeric(start) Then start = 0
   Loop While Len(start) <> 4 Or CInt(start) < 1900 Or CInt(start) > 3999
   Do
   ende = InputBox("Bitte geben Sie das Endjahr ein." & vbLf & _
      "Die Jahreszahl muss vierstellig sein!", "Ende", CStr(Year(Date) - 10))
      If ende = "" Then Exit Sub
      If Not IsNumeric(ende) Then ende = 0
   Loop While Len(ende) <> 4 Or CInt(ende) < 1900 Or CInt(ende) > 3999 Or CInt(ende) >= start
start = CInt(start)
ende = CInt(ende)
   With Sheets(1) 'Tabelle anpassen
   .Range("A2:B1000").ClearContents
   'Bereich "A2:B1000" löschen
      For intC = 2 To (start - ende) + 2
      .Cells(intC, 1) = (start + 2) - intC
      .Cells(intC, 2).FormulaR1C1 = "=IF(RC[-1]>YEAR(TODAY())-10,""X"","""")"
      'Formel für Spalte "B" nur als Beispiel
      'Für Deine Formel am besten den Makrorekorder benutzen!
      Next
   End With
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Gib bitte Bescheid, egal ob positiv oder negativ.
Gruß Sepp

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread