Çoklu Sayfa Kopyalama - Baskı Önizleme

Çoklu Sayfa Kopyalama - Baskı Önizleme

+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Çoklu Sayfa Kopyalama (/konu-coklu-sayfa-kopyalama.html)

Çoklu Sayfa Kopyalama - nightashes - 10/06/2019

Herkese merhaba,

Benim sorum şu şekilde. Sayfa1 de benim kopyalamak istediğim şablonum mevcut. Bu şablon hedef alınarak Sayfa2 de bulunan değerlere göre topluca yeni sayfalar açmak istiyorum.
Sayfa 2 de A kolonunda sayfalara vermek istediğim ad B kolonunda yeni sayfalarda istediğim hücreye yazılacak değerler, C kolonunda yeni sayfalarda istediğim hücreye yazılacak değer D kolonunda istediğim hücreye yazılacak değerler olacak.

Şimdiden teşekkür ederim.

Cvp: Çoklu Sayfa Kopyalama - nightashes - 10/06/2019

Tekrar merhaba,

Public Sub berat()

On Error Resume Next

Dim MyCell As Range, MyRange As Range, deger1 As Range, deger2 As Range, deger3 As Range



Set MyRange = Sheets("Sayfa2").Range("A2")

Set MyRange = Range(MyRange, MyRange.End(xlDown))

Set deger1 = Sheets("Sayfa2").Range("B2")

Set deger1 = Range(deger1, deger1.End(xlDown))

Set deger2 = Sheets("Sayfa2").Range("C2")

Set deger2 = Range(deger2, deger2.End(xlDown))

Set deger3 = Sheets("Sayfa2").Range("D2")

Set deger3 = Range(deger3, deger3.End(xlDown))



For Each MyCell In MyRange

Sheets("Sayfa1").Copy After:=Sheets(Sheets.Count)

Sheets(Sheets.Count).Name = MyCell.Value

Sheets(Sheets.Count).Range("b3").Value = deger1.Value

Sheets(Sheets.Count).Range("f6").Value = deger2.Value

Sheets(Sheets.Count).Range("g4").Value = deger3.Value

Next MyCell





End Sub

Bu şekilde bir kod oluşturdum. Güzel olan taraf A kolonuna göre isimlere sahip sayfa açabiliyorum. Ama açtığım sayfalara istediğim hücrelere yazım yaptıramıyorum.
Yardım ederseniz sevinirim.

Cvp: Çoklu Sayfa Kopyalama - berduş - 10/06/2019

aşağıdaki gibi düzenleyip dener misiniz?

Public Sub berat()

On Error Resume Next

Dim MyCell As Range, MyRange As Range, deger1 As Range, deger2 As Range, deger3 As Range

Dim intSatir As Integer



Set MyRange = Sheets("Sayfa2").Range("A2")

Set MyRange = Range(MyRange, MyRange.End(xlDown))

Set deger1 = Sheets("Sayfa2").Range("B2")

Set deger1 = Range(deger1, deger1.End(xlDown))

Set deger2 = Sheets("Sayfa2").Range("C2")

Set deger2 = Range(deger2, deger2.End(xlDown))

Set deger3 = Sheets("Sayfa2").Range("D2")

Set deger3 = Range(deger3, deger3.End(xlDown))



For Each MyCell In MyRange



Sheets("Sayfa1").Copy After:=Sheets(Sheets.Count)



intSatir = MyCell.Row ' <== eklenen

Sheets(Sheets.Count).Name = MyCell.Value

Sheets(MyCell.Value).ClearContents ' <== eklenen

Sheets(MyCell.Value).Range("b3").Value = Sheets("Sayfa2").Range("B" & intSatir).Value ' <== değişen

Sheets(MyCell.Value).Range("f6").Value = Sheets("Sayfa2").Range("C" & intSatir).Value

Sheets(MyCell.Value).Range("g4").Value = Sheets("Sayfa2").Range("D" & intSatir).Value

Next MyCell





End Sub

Cvp: Çoklu Sayfa Kopyalama - nightashes - 10/06/2019

(10/06/2019, 14:48)haliliyas yazdı: aşağıdaki gibi düzenleyip dener misiniz?

Public Sub berat()

On Error Resume Next

Dim MyCell As Range, MyRange As Range, deger1 As Range, deger2 As Range, deger3 As Range

Dim intSatir As Integer



Set MyRange = Sheets("Sayfa2").Range("A2")

Set MyRange = Range(MyRange, MyRange.End(xlDown))

Set deger1 = Sheets("Sayfa2").Range("B2")

Set deger1 = Range(deger1, deger1.End(xlDown))

Set deger2 = Sheets("Sayfa2").Range("C2")

Set deger2 = Range(deger2, deger2.End(xlDown))

Set deger3 = Sheets("Sayfa2").Range("D2")

Set deger3 = Range(deger3, deger3.End(xlDown))



For Each MyCell In MyRange



Sheets("Sayfa1").Copy After:=Sheets(Sheets.Count)



intSatir = MyCell.Row ' <== eklenen

Sheets(Sheets.Count).Name = MyCell.Value

Sheets(MyCell.Value).ClearContents ' <== eklenen

Sheets(MyCell.Value).Range("b3").Value = Sheets("Sayfa2").Range("B" & intSatir).Value ' <== değişen

Sheets(MyCell.Value).Range("f6").Value = Sheets("Sayfa2").Range("C" & intSatir).Value

Sheets(MyCell.Value).Range("g4").Value = Sheets("Sayfa2").Range("D" & intSatir).Value

Next MyCell





End Sub

Çok teşekkür ederim. Aramadığım yer kalmamıştı. İstediğim gibi değerleri çekiyor.