Rows Insert Formula Copy!

With an input box rows are inserted and the formulas are copied. In cell A1 is a number and in cell A2 then "=A1+A2" and so on. The last code is an example of several columns. The files at the end of the article are Excelfiles of the version 2003 and 2007. The following code belonged in "Module1".


Mit einer Inputbox werden Zeilen eingefügt und die Formeln kopiert. In Zelle A1 steht eine Zahl und in Zelle A2 dann "=A1+A2" und so weiter. Der letzte Code ist ein Beispiel für mehrere Spalten. Die Dateien am Ende des Artikels sind Exceldateien der Version 2003 und 2007. Der folgende Code gehört in "Modul1".


Option Explicit

Public Sub Add_1()
Dim varTMP As Variant
Dim lngRow As Long
On Error GoTo Fin
varTMP = Application.InputBox("Row", "Number", "5", , , , , 1)
If varTMP = False Then Exit Sub
Application.ScreenUpdating = False
lngRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A" & lngRow & ":A" & lngRow + varTMP).FillDown
Fin:
Application.ScreenUpdating = True
End Sub

Public Sub Insert_1()
Dim varTMP As Variant
Dim lngRow As Long
On Error GoTo Fin
varTMP = Application.InputBox("Row", "Number", "5", , , , , 1)
If varTMP = False Then Exit Sub
Application.ScreenUpdating = False
lngRow = Cells(Rows.Count, 1).End(xlUp).Row
Range(Rows(ActiveCell.Offset(1).Row), _
Rows(ActiveCell.Row + varTMP)).Insert
Range("A" & ActiveCell.Row & ":A" & lngRow + varTMP).FillDown
Fin:
Application.ScreenUpdating = True
End Sub

Public Sub Insert_2()
Dim varTMP As Variant
Dim lngRow As Long
On Error GoTo Fin
varTMP = Application.InputBox("Row", "Number", "5", , , , , 1)
If varTMP = False Then Exit Sub
Application.ScreenUpdating = False
lngRow = Cells(Rows.Count, 1).End(xlUp).Row
Range(Rows(ActiveCell.Offset(1).Row), _
Rows(ActiveCell.Row + varTMP)).Insert
Range("A2").Formula = "=A1+1"
Range("A2" & ":A" & lngRow + varTMP).FillDown
Fin:
Application.ScreenUpdating = True
End Sub

Public Sub Insert_3()
Dim varTMP As Variant
Dim lngRow As Long
On Error GoTo Fin
varTMP = Application.InputBox("Row", "Number", "5", , , , , 1)
If varTMP = False Then Exit Sub
Application.ScreenUpdating = False
lngRow = Cells(Rows.Count, 1).End(xlUp).Row
If ActiveCell.Address = "$A$1" Then
Range("A2").Formula = "=A1+1"
Range("A2" & ":A" & lngRow + varTMP).FillDown
Else
Range(Rows(ActiveCell.Offset(1).Row), _
Rows(ActiveCell.Row + varTMP)).Insert
Range("A" & ActiveCell.Row & ":A" & lngRow + varTMP).FillDown
End If
Fin:
Application.ScreenUpdating = True
End Sub

Public Sub Insert_4()
Dim intTMP As Integer
Dim varTMP As Variant
Dim lngRow As Long
On Error GoTo Fin
varTMP = Application.InputBox("Row", "Number", "5", , , , , 1)
If varTMP = False Then Exit Sub
Application.ScreenUpdating = False
lngRow = Cells(Rows.Count, 1).End(xlUp).Row
If ActiveCell.Row = 1 Then
For intTMP = 1 To Cells(3, Columns.Count).End(xlToLeft).Column
Cells(2, intTMP).Formula = _
Cells(2, intTMP).Formula
Range(Cells(2, intTMP), _
Cells(lngRow + varTMP, intTMP)).FillDown
Next intTMP
Else
Range(Rows(ActiveCell.Offset(1).Row), _
Rows(ActiveCell.Row + varTMP)).Insert
For intTMP = 1 To Cells(3, Columns.Count).End(xlToLeft).Column
Range(Cells(ActiveCell.Row, intTMP), _
Cells(lngRow + varTMP, intTMP)).FillDown
Next intTMP
End If
Fin:
Application.ScreenUpdating = True
End Sub


Sample 2003

Sample 2007

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...