Otomatik Satır Ekleme VBA veya Makro ile

[Omerullah]

Sayın Uzman Arkadaşlar,

Excelde oluşturulmuş bir tabloya B sütununa veri girilince otomatik aşağıdaki kod ile satır ekleniyor.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, Range("B3:B65536")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If UCase$(Target) > 0 Then
Rows(Target.Row + 1).Insert
End If
Son:
Application.EnableEvents = True
End Sub

Yukarıdaki koda şunları eklemek istiyorum. B Sütununa veri girilince A sütununa otomatik sıra numarası ve AJ sütununda bulunan formülü eklenen satıra kobyalanmasını istiyorum. Çok değerli yardımınızı siz uzman arkadaşlardan rica ediyorum.

Saygılarımla.
Ömer ÜZÜMCÜ

 

[f_desat]

denermisiniz sorunu örnek çalışma ile destekeler iseniz AJ alanındaki formül nereye kopyalanacak daha iyi yardımcı olabiliriz .

sadece sıra numarası verir

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For sira = 1 To WorksheetFunction.CountA(Range("b1:b65536"))

Range("a" & sira + 1) = sira

Next sira


End Sub

 

[dEdE]

Merhaba,
Aşağıda kırmızı ile belirttiğim kodu mevcut kodunuzda siyah ile belirttiğim satırların arasına ekleyip dener misiniz? (mevcut kodunuzun son satırının hemen üstüne)

Application.EnableEvents = True
[COLOR="Red"][A3] = 1
[A3].AutoFill Range("A3:A" & [B65536].End(3).Row), xlFillSeries
Range("AJ" & Target.Row).AutoFill Range("AJ" & Target.Row & ":AJ" & Target.Row + 1), xlFillDefault[/COLOR]
End Sub

 

[Omerullah]

Merhaba,
Aşağıda kırmızı ile belirttiğim kodu mevcut kodunuzda siyah ile belirttiğim satırların arasına ekleyip dener misiniz? (mevcut kodunuzun son satırının hemen üstüne)

Application.EnableEvents = True
[COLOR="Red"][A3] = 1
[A3].AutoFill Range("A3:A" & [B65536].End(3).Row), xlFillSeries
Range("AJ" & Target.Row).AutoFill Range("AJ" & Target.Row & ":AJ" & Target.Row + 1), xlFillDefault[/COLOR]
End Sub

Sayın dEdE,

Yukarıdaki verdiğiniz kodu uyguladığım örnek dosya ekteki gibi olup, istenileni vermemiştir.

Saygılarımla.
Ömer ÜZÜMCÜ

 

[Omerullah]

denermisiniz sorunu örnek çalışma ile destekeler iseniz AJ alanındaki formül nereye kopyalanacak daha iyi yardımcı olabiliriz .

sadece sıra numarası verir

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For sira = 1 To WorksheetFunction.CountA(Range("b1:b65536"))

Range("a" & sira + 1) = sira

Next sira


End Sub

Sayın f_desat,

Kod 4. mesajda vermiş olduğum örnek dosyada istenileni vermemiştir.

Saygılarımla.
Ömer ÜZÜMCÜ

 

[dEdE]

Merhaba,
Hayali dosyaya kod yazmanın sonucu budur.
Örnek dosyanızı baştan eklememeniz böyle uzun yazışmalara neden oluyor. Aşağıdaki kodu dener misiniz?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("B3:B65536")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If UCase$(Target) > 0 Then
    Rows(Target.Row + 1).Insert
    End If
Son:
    [B]Cells(Target.Row, 1).Value = Cells(Target.Row - 1, 1).Value + 1
    Range("AJ" & Target.Row - 1).AutoFill Range("AJ" & Target.Row - 1 & ":AJ" & Target.Row), xlFillDefault[/B]
    Application.EnableEvents = True
End Sub

 

[Omerullah]

Sayın dEdE,

Öncelikle konuya gösterdiğiniz ilgi ve değerli çözümünüz için size çok teşekkür ederim. Sizden daha önceleri de yardım almıştım. Ayrıca, onlar içinde size minnettarım. Daha önce bu konu ile ilgili bir konu açmıştım ama, sanırım uzman arkadaşların yoğunluğu veya konunun ilgi görmemesiden olabilir, her hangi bir yardım alamamıştım. Sitedeki uzmanların mesala Sayın Levent bey, Sayın Necdet bey, Sayın Yurttaş bey, Sayın Orion1, Sayın 1Al2Ver, ve diğer uzman arkadaşlar için konu çok basit kalabilir, yoğunlukları sebebiyle cevap veremediklerini düşünerek, her hangi bir hatırlatma yapmadım. Bu sebeple Eski konuda isteklerimin tamamını değil bir kısmını (Öncelikli olanını) bu konuda yapmaya çalıştım. Konunun tamamını aşağıdaki linkten inceleyebilirsiniz. Size ve tüm site yöneticilerine bilgi palaşımları içi saygı duyuyor ve ve bu metin bir kez daha teşekkürlerimi iletiyorum.


Önceki Konu: http://www.excel.web.tr/f48/satyrlary-otomatik-gizleme-gosterme-ve-numaralandyrma-t124414.html

Saygılarımla.