Biçimi ile ve Son dolu satırı alt satıra kopyala ve yapıştır.

Katılım
13 Ekim 2016
Mesajlar
30
Excel Vers. ve Dili
Microsoft excel 2010
Sayın ilgili,

Dosyamda aşağıdaki kodları kullanarak bir Userform oluşturdum. Sayfa 1 de butonla açılan userform daki satırlara yazdıklarım Sayfa 1 de Son boş satıra gidip belirtmiş olduğum aralıklara yapışıyor (Bir yeni müşteri açma formu bilgileri ile ) . Bu durumda sorun yaşamıyorum fakat devamı olarak araya eklemek istediğim şey Yine Sayfa 1 de ''J:AA '' arasında formüller kullandığım satırı yeni oluşan müşterinin satırına aynı şekilde kopyalasın ki işlem devam edebilsin. ve tabii son satırın biçiminide aynı şekilde kopyalması gerekiyor.

Userform ( Müşteri bilgisi ekleme )

Private Sub CommandButton1_Click()
Range("A2").Select
Do While Not IsEmpty(Activecell)
Activecell.Offset(1, 0).Select
Loop
If IsNumeric(Activecell.Offset(-1, 0).Value) = True Then
Activecell.Value = Activecell.Offset(-1, 0).Value
End If
Activecell.Offset.Value = TextBox1.Text
Activecell.Offset(0, 1).Value = TextBox2.Text
Activecell.Offset(0, 4).Value = TextBox3.Text
Activecell.Offset(0, 6).Value = TextBox4.Text
MsgBox ("Kayıt Tamamlandı")
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
End Sub
 
Katılım
13 Ekim 2016
Mesajlar
30
Excel Vers. ve Dili
Microsoft excel 2010
bu konuda yardımcı olabilecek birisi varmı??? :))
 
Katılım
13 Ekim 2016
Mesajlar
30
Excel Vers. ve Dili
Microsoft excel 2010
Sayın Korhan bey, yada destek ekibi,

Userform içinde bu işlem kafa karıştırdı benim açımdan yukarıda belirtilen kopyalama işlemini userformu çağıran kod kısmın da yapabilirmiyiz?

beklentim açık aslında Userform ile oluşturulan müşteri listesi A,B,C,D de işlem yapıyor J:AA arasında ise formüller var fakat yeni girilen satırda (en son satır) üsteki formüller gelmiyor onlarında gelmesi için bir kod rica ediyorum.

Sub Button29_Click()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

UserForm1.Show

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,159
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

Kod:
Private Sub CommandButton1_Click()
    Range("A2").Select
    Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop
    If IsNumeric(ActiveCell.Offset(-1, 0).Value) = True Then
    ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
    End If
    ActiveCell.Offset.Value = TextBox1.Text
    ActiveCell.Offset(0, 1).Value = TextBox2.Text
    ActiveCell.Offset(0, 4).Value = TextBox3.Text
    ActiveCell.Offset(0, 6).Value = TextBox4.Text
    Range("J" & ActiveCell.Row - 1 & ":AA" & ActiveCell.Row - 1).Copy Range("J" & ActiveCell.Row)
    MsgBox ("Kayıt Tamamlandı")
    TextBox1.Text = ""
    TextBox2.Text = ""
    TextBox3.Text = ""
    TextBox4.Text = ""
End Sub
 
Katılım
13 Ekim 2016
Mesajlar
30
Excel Vers. ve Dili
Microsoft excel 2010
Korhan bey çok güzel olmuş elinize sağlık ama userform üzerinde A sutununa atatığım değer(firma adı) için bir üstündeki satırın da biçim boyasının gelmesi gerekiyor çünkü orda kural oluşturmuştum. bu konuda bir çözümünüz varsa harika olur.
 
Katılım
13 Ekim 2016
Mesajlar
30
Excel Vers. ve Dili
Microsoft excel 2010
korhan Bey aşağıdaki kodu ekledim oldu :) tekrar teşekkürler şimdilik hoşçakalın ama burda kalın :))

Range("A" & ActiveCell.Row - 1).Copy

Range("A" & ActiveCell.Row).PasteSpecial Paste:=xlPasteFormats
 
Katılım
13 Ekim 2016
Mesajlar
30
Excel Vers. ve Dili
Microsoft excel 2010
Korhan Bey başka bir sorun oldu J:AA arasında gizlenmiş sutunlar vardı (M den R dahil ) ve (V den Z dahil ) bunlarda kopyalama yapmıyor , eğer açıksa yapıyor kapalıysa yapmıyor
 
Katılım
13 Ekim 2016
Mesajlar
30
Excel Vers. ve Dili
Microsoft excel 2010
Yani bir sutun dahi gizlenmiş olsa formülasyonu bozuluyor .
Denemek için (M den R dahil ) bu sutunları kapadım (V den Z dahil ) bu sutunları açtım , sadece kapalı olanlarımı etkiliyor diye ama diğerleride bozuluyor.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,159
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Sütunun kapalı olması kopyalanmasına engel olmaması gerekir. Sizin dosyanızda başka bir durum olabilir.

Dosyanızı paylaşırsanız (paylaşım sitelerine yükleyip link verebilirsiniz) inceleme fırsatımız olabilir.
 
Katılım
13 Ekim 2016
Mesajlar
30
Excel Vers. ve Dili
Microsoft excel 2010
Korhan Bey Hallettim sanırım vermiş olduğunuz örnekten yola çıkarak tek tek her satıra ayrı ayrı yaptım arada formül olmayan hücreleri eledim. şu an çalışıyor. Tekrar teşekkürler :)))


Private Sub CommandButton1_Click()
Range("A2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If IsNumeric(ActiveCell.Offset(-1, 0).Value) = True Then
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
End If
ActiveCell.Offset.Value = TextBox1.Text
ActiveCell.Offset(0, 1).Value = TextBox2.Text
ActiveCell.Offset(0, 4).Value = TextBox3.Text
ActiveCell.Offset(0, 6).Value = TextBox4.Text
Range("J" & ActiveCell.Row - 1).Copy Range("J" & ActiveCell.Row)
Range("K" & ActiveCell.Row - 1).Copy Range("K" & ActiveCell.Row)
Range("L" & ActiveCell.Row - 1).Copy Range("L" & ActiveCell.Row)
Range("M" & ActiveCell.Row - 1).Copy Range("M" & ActiveCell.Row)
Range("O" & ActiveCell.Row - 1).Copy Range("O" & ActiveCell.Row)
Range("Q" & ActiveCell.Row - 1).Copy Range("Q" & ActiveCell.Row)
Range("S" & ActiveCell.Row - 1).Copy Range("S" & ActiveCell.Row)
Range("T" & ActiveCell.Row - 1).Copy Range("T" & ActiveCell.Row)
Range("U" & ActiveCell.Row - 1).Copy Range("U" & ActiveCell.Row)
Range("V" & ActiveCell.Row - 1).Copy Range("V" & ActiveCell.Row)
Range("W" & ActiveCell.Row - 1).Copy Range("W" & ActiveCell.Row)
Range("X" & ActiveCell.Row - 1).Copy Range("X" & ActiveCell.Row)
Range("Y" & ActiveCell.Row - 1).Copy Range("Y" & ActiveCell.Row)
Range("Z" & ActiveCell.Row - 1).Copy Range("Z" & ActiveCell.Row)
Range("AA" & ActiveCell.Row - 1).Copy Range("AA" & ActiveCell.Row)

Range("A" & ActiveCell.Row - 1).Copy
Range("A" & ActiveCell.Row).PasteSpecial Paste:=xlPasteFormats
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
MsgBox ("Kayıt Tamamlandı")

End Sub
 
Üst