Konu Araçları | Konu Seçenekleri | Gösterim Stili
Tarih
10/06/2019 10:50
Konu Sahibi
nightashes
Yorumlar
3
Okunma
146
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 5
  • 4
  • 3
  • 2
  • 1

Derecelendirme: 0/5 - 0 oy
nightashes

nightashes

Aktif Üye
78791
Se.... Be.... AY....
 33
 38
 144
 30/12/2015
11
 Sakarya
 İnşaat Yük. Müh.
 Ofis 2013 32 Bit
 13/06/2019,17:31
Çözüldü 
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.


Alıntı:Her şey bir fikirle başlar.

nightashes

nightashes

Aktif Üye
78791
Se.... Be.... AY....
 33
 38
 144
 30/12/2015
11
 Sakarya
 İnşaat Yük. Müh.
 Ofis 2013 32 Bit
 13/06/2019,17:31
Tekrar merhaba,

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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.


Alıntı:Her şey bir fikirle başlar.

...........
halily

halily

Uzman
65596
Ha....
 26
 1.155
 30/07/2014
209
 -
 
 Ofis 2019 64 Bit
 Bugün,11:45
aşağıdaki gibi düzenleyip dener misiniz?

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
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



nightashes

nightashes

Aktif Üye
78791
Se.... Be.... AY....
 33
 38
 144
 30/12/2015
11
 Sakarya
 İnşaat Yük. Müh.
 Ofis 2013 32 Bit
 13/06/2019,17:31
(10/06/2019 14:48)haliliyas Adlı Kullanıcıdan Alıntı: aşağıdaki gibi düzenleyip dener misiniz?

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
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.


Alıntı:Her şey bir fikirle başlar.

...........

Konuyu Okuyanlar: 1 Ziyaretçi

Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
Çözüldü Ekders Uygulamasında Sayfa 1'de Silinen Verilerin Sayfa 3'te Silinmemesi martineden-30 2 132 04/06/2019, 16:11
Son Yorum: martineden-30
Çözüldü Webde Çoklu Sorgu Yapmak beyazmermi 2 224 22/03/2019, 15:18
Son Yorum: beyazmermi
Çözüldü Makro İle Çoklu Satır Taşıma boraday 9 4.238 05/01/2017, 17:18
Son Yorum: turankr
Çözüldü Çoklu Süzme Arama alanında Hata kenevir47 8 1.222 09/12/2016, 16:18
Son Yorum: kenevir47
Çözüldü Listbox a gelen veriyi kopyalama veya ilgili satıra gitme hsendogan 4 1.690 15/06/2016, 16:57
Son Yorum: atoz112

Türkçe Çeviri: MCTR, Yazılım: MyBB, © 2002-2019 MyBB Group.