Seçilen verilerin İstenilen sayfaya kopyalanması

[Erdal1962]

Merhaba Saygıdeğer üyeler
Bir konu hakkında yardımınız gerekmekte.
Verilerim Tablo olarak Teklif Sayfasında A12 den başlayarak F59 A kadar bulunmakta
Ama kopyalanacak veriler süz işlemi yapıldıktan sonra kalan verileri formül kopyalamadan ve biçimleri koruyarak İstediğim Firma sayfasını seçerek ilgili sayfasına kopyalamak.Firma isimleri sabittir.
Kopyalanacak firma sayfalarında veriler olacağı için boş bulunan ilk satıra kopyalanması.
Çünkü yazılan teklif temizle makrosu çalıştırıldığında TEKLİF SAYFASINDA veri kalmıyor.
Yeni teklifi hazırlamadan evvel bu kopyalama işini çözmem lazım.
Dosya Linki Ektedir

Şimdiden ilginize teşekkür ederim.

https://dosya.co/xlkwdncx9dqe/TEKLİF_HESAPLAMA-REVİZYON_-_Kopya.xlsb.html

 

[Erdal1962]

Merhabalar.
Sorunum ile ilgili çözüm gösterecek biri olursa sevinirim.
Saygılarımla

 

[tahsinanarat]

Sn. @Erdal1962 sayfanın kod bölümüne;

Private Sub CommandButton1_Click()
Set S1 = Sheets("Teklif")Sheets
Set S2 = Sheets(Sheets("Teklif").[B7].Text)
For i = 12 To S1.Range("A65536").End(3).Row
If S1.Cells(i, 1).EntireRow.Hidden = False Then
SONSTR = S2.Range("B65536").End(3).Row + 1
S2.Cells(SONSTR, 1).Value = S1.Cells(i, 1).Value
S2.Cells(SONSTR, 2).Value = S1.Cells(i, 2).Value
S2.Cells(SONSTR, 3).Value = S1.Cells(i, 3).Value
S2.Cells(SONSTR, 4).Value = S1.Cells(i, 4).Value
S2.Cells(SONSTR, 5).Value = S1.Cells(i, 5).Value
S2.Cells(SONSTR, 6).Value = S1.Cells(i, 6).Value
S2.Cells(SONSTR, 7).Value = S1.Cells(i, 7).Value
S2.Cells(SONSTR, 8).Value = S1.Cells(i, 8).Value
End If
Next
S2.Select
End Sub

yazıp, Teklif sayfasına CommandButton1 ekleyerek denermisiniz,
Not: Aktarılacak sayfa ismini B7 hücresinden alacağından, B7 Hücresindeki Firma İsmi Sayfa ismi ile eşleşmeli

 

[Erdal1962]

Sn. @Erdal1962 sayfanın kod bölümüne;

Private Sub CommandButton1_Click()
Set S1 = Sheets("Teklif")Sheets
Set S2 = Sheets(Sheets("Teklif").[B7].Text)
For i = 12 To S1.Range("A65536").End(3).Row
If S1.Cells(i, 1).EntireRow.Hidden = False Then
SONSTR = S2.Range("B65536").End(3).Row + 1
S2.Cells(SONSTR, 1).Value = S1.Cells(i, 1).Value
S2.Cells(SONSTR, 2).Value = S1.Cells(i, 2).Value
S2.Cells(SONSTR, 3).Value = S1.Cells(i, 3).Value
S2.Cells(SONSTR, 4).Value = S1.Cells(i, 4).Value
S2.Cells(SONSTR, 5).Value = S1.Cells(i, 5).Value
S2.Cells(SONSTR, 6).Value = S1.Cells(i, 6).Value
S2.Cells(SONSTR, 7).Value = S1.Cells(i, 7).Value
S2.Cells(SONSTR, 8).Value = S1.Cells(i, 8).Value
End If
Next
S2.Select
End Sub

yazıp, Teklif sayfasına CommandButton1 ekleyerek denermisiniz,
Not: Aktarılacak sayfa ismini B7 hücresinden alacağından, B7 Hücresindeki Firma İsmi Sayfa ismi ile eşleşmeli

İlginize teşekkürler Sn. tahsinanarat
Yazmış olduğunuz kodları Teklif sayfasının kod kısmına ekledim,Teklif sayfasında Commandbutton butonu ekledim. Firma ismi ile sayfa adını aynı yaptığım halde hata verdi.
Private Sub CommandButton1_Click() (Sarı renkte hata)
Set S1 = Sheets("Teklif")Sheets (Kırmızı yazı olarak hata)
Acaba bir yerde hatamı yaptım.

 

[Korhan Ayhan]

Kırmızı bölümü silip deneyiniz.

Set S1 = Sheets("Teklif")Sheets

 

[tahsinanarat]

Sn. @Erdal1962 Korhan hocam cevaplamış.
Kolay gelsin.

 

[Erdal1962]

Merhabalar
Sayın tahsinanarat ve Korhan Hocam
İlgilerinize teşekkür ederim.Kod larda hatalı yeri silince her istediğim sayfaya yapıştırma yapıyor.

Kod:
Private Sub CommandButton1_Click()
Set S1 = Sheets("Teklif")
Set S2 = Sheets(Sheets("Teklif").[B7].Text)
For i = 12 To S1.Range("A65536").End(3).Row
If S1.Cells(i, 1).EntireRow.Hidden = False Then
SONSTR = S2.Range("B65536").End(3).Row + 1
S2.Cells(SONSTR, 1).Value = S1.Cells(i, 1).Value
S2.Cells(SONSTR, 2).Value = S1.Cells(i, 2).Value
S2.Cells(SONSTR, 3).Value = S1.Cells(i, 3).Value
S2.Cells(SONSTR, 4).Value = S1.Cells(i, 4).Value
S2.Cells(SONSTR, 5).Value = S1.Cells(i, 5).Value
S2.Cells(SONSTR, 6).Value = S1.Cells(i, 6).Value
S2.Cells(SONSTR, 7).Value = S1.Cells(i, 7).Value
S2.Cells(SONSTR, 8).Value = S1.Cells(i, 8).Value
End If
Next
S2.Select
End Sub

Ama aynı şirkete mesela 2-3 defa kopyalama yaptık diyelim biçimler bozuluyor.
Benim istediğim Değerler ve kaynak biçimlendirmesini koruyarak aynı şekilde kopyalaması.

Resimde A2 de olan makro ile kopyalama.
A11 hücresinde olan Manuel kopyala yapıştır.
Bu yapıştırma işini de yöntem gösterirseniz işim hallolacak.

Saygılarımla

İndir YAPIŞTIRMA

Dosyayı indir YAPIŞTIRMA

dosya.co

 

[tahsinanarat]

Sn. @Erdal1962 1.Mesajınızdaki verdiğiniz linkteki örnek dosya üzerinde ben deniyorum, biçimlendirmelerde herhangi bir bozulma görümeyorum.
Yada ben farklı anladım. O dosyanıza uygulanmış halini ekte gönderiyorum.

 

[Erdal1962]

Sn. @Erdal1962 1.Mesajınızdaki verdiğiniz linkteki örnek dosya üzerinde ben deniyorum, biçimlendirmelerde herhangi bir bozulma görümeyorum.
Yada ben farklı anladım. O dosyanıza uygulanmış halini ekte gönderiyorum.

Merhabalar tahsinararat
Şimdi şöyle söyliyeyim teklif sayfasında gerçek A12 satırı yeşil ile yazılı
onun alt bölümlerindeki ama A - G - H sütünları yazı karekterleri beyaz renk olduğu için gözükmüyor. Yani ben kopyalama yaptığımda kaynak ve biçimlendirme aynı şekilde kopyalasın istiyorum.Hücrelerdeki yeşil ise yeşil beyaz ise beyaz 12 punto ise 12 -8 punto ise 8 olarak yapışsın.