Makro ile Satır ekleme ve Formul kopyalama

[KARPO]

Selam arkadaslar,
Makro ile insert row(satir ekleme) olusturdum fakat formulleri devam ettiremiyor. Ornek formul A1 hucresinde ve ben otomatik satir eklerken makro ile , A2,A3 .... hucrelerinde bu formulu kopyalayamiyorum otomatik olarak. Bir fikri olan varmi ? Bu arada formulum Vlookup. Makro da su sekilde:

Private Sub CommandButton1_Click()
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

'MsgBox LastRow
rijtje = LastRow + 1
rijtje57 = LastRow + 57
'Rows("""" & LastRow + 1 & ":" & LastRow + 1 & """").Select
'Selection.Insert Shift:=xlDown
Rows(rijtje & ":" & rijtje57).Select
Selection.Insert Shift:=xlUp
End Sub

 

[uzmanamele]

merhaba

örnek dosya eklerseniz daha net yanıt alabilirsiniz.

ek dosyayı inceleyiniz, A sütununa veri girerek deneyiniz.

'kod syn Korhan Ayhan'dan alınmıştır
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Son_Satır As Long
    If Intersect(Target, [A4:A65536]) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    Son_Satır = [A65536].End(3).Row
    If Target.Row = Son_Satır - 2 And Target <> "" Then
    Rows(Target.Row + 1).Copy
    If Son_Satır > 100 Then
    Rows((Target.Row + 1) & ":" & (Target.Row + 4)).Insert Shift:=xlDown
    ElseIf Son_Satır > 75 Then
    Rows((Target.Row + 1) & ":" & (Target.Row + 6)).Insert Shift:=xlDown
    ElseIf Son_Satır > 20 Then
    Rows((Target.Row + 1) & ":" & (Target.Row + 11)).Insert Shift:=xlDown
    Else
    Rows((Target.Row + 1)).Insert Shift:=xlDown
    End If
    Application.CutCopyMode = False
    End If
End Sub

 

[KARPO]

Tekrar merhaba , dosyayi ekte gonderiyorum.