Filtrelenen hucrelere gore kopyalama

[montrama]

Merhabalar,

Jandarma olarak TSK da gorev yapiyorum ve personellere tebrik karti gonderme hazirlama ile ilgili bir excel calismasi yapiyorum. Calismanin birinci sayfasinda personel bilgileri ve dogum gunleri var, ikinci sayfada personel bilgileri ve evlilik tarihleri var, 3. ve 4. sayafalara ise belirledigim tarih araligina gore bu personelin listesini aliyorum. Buraya kadar sorun yok, sorum su;

5. Sayfamda bir tebrik karti var, filtrelemis oldugum listede ki her personel icin bu tebrik mesajini alt alta ekleyip, personelin ad soyad, rutbe ve gorev yeri bilgilerini otomatik olarak atamak. Amacim tek seferde yazicidan tum tebrik kartlarini alabilmek. Boyle bir sey mumkun mu, mumkunse yardimlarinizi bekliyorum, simdiden tesekkurler

 

[halit3]

Merhabalar,

Jandarma olarak TSK da gorev yapiyorum ve personellere tebrik karti gonderme hazirlama ile ilgili bir excel calismasi yapiyorum. Calismanin birinci sayfasinda personel bilgileri ve dogum gunleri var, ikinci sayfada personel bilgileri ve evlilik tarihleri var, 3. ve 4. sayafalara ise belirledigim tarih araligina gore bu personelin listesini aliyorum. Buraya kadar sorun yok, sorum su;

5. Sayfamda bir tebrik karti var, filtrelemis oldugum listede ki her personel icin bu tebrik mesajini alt alta ekleyip, personelin ad soyad, rutbe ve gorev yeri bilgilerini otomatik olarak atamak. Amacim tek seferde yazicidan tum tebrik kartlarini alabilmek. Boyle bir sey mumkun mu, mumkunse yardimlarinizi bekliyorum, simdiden tesekkurler

Telefondan girdigim icin upload biraz zor oldu ama;

http://excel.web.tr/attachment.php?attachmentid=170856&d=1415293103

Eklemiş olduğunuz link bozuk

 

[montrama]

Dosyayi ekleyebildim sonunda

 

[halit3]

Dosyayi ekleyebildim sonunda

Yazdırmak istediğiniz döküm sayfasında herhangi bir bilgi yok

döküm sayfasına bilgiler hangi sayfadan gelip yazdıracaksınız.

 

[montrama]

Filtrelenmis olan sayfalardan ad rutbe ve gorev yeri verilerinin aktarilmasini istiyorum ama beceremedim

 

[halit3]

Filtrelenmis olan sayfalardan ad rutbe ve gorev yeri verilerinin aktarilmasini istiyorum ama beceremedim

4 nolu mesajımda bahsetmiştim ama herhalde anlaşılmadı

örnek dosyanıza döküm sayfanızla ilgili bir kişiye ait verileri hangi sayfadan almak istiyorsanız manuel ekleyin hatta renkli olarak belirtin ki bizde nereden hangi veri alınacak bilelim.

 

[montrama]

Dogum Gunu Rapor sayfasinda ki kisilerin tamami icin dokum sayfasinda olan tebrik kartinin alt alta eklenip, ortada bulunan kirmizi yere ad-soyad, rutbe ve gorev yerlerini otomatik olarak aktarmak istiyorum. Ornegin Dogum gunu rapor sayfasinda 3 kisi listelendi, bilgleri aktar gibi bir dugmeye basildiginda dokum sayfasinda; tebrik kartindan 3 adet koyarak dogum gunu rapor sayfasinda ki ad-soyad, rutbe ve vorev yeri bilgilerini tebrik kartinin ortasinda bulunan kirmizi yerlere yazdiracak. Dosya ekleme konusunda cok ciddi sorun yasiyorum ama yinede tekrar ekleyin diyorsaniz gerekli izinler icin ugrasim. Ilginize tesekkur ederim.

 

[halit3]

Dogum Gunu Rapor sayfasinda ki kisilerin tamami icin dokum sayfasinda olan tebrik kartinin alt alta eklenip, ortada bulunan kirmizi yere ad-soyad, rutbe ve gorev yerlerini otomatik olarak aktarmak istiyorum. Ornegin Dogum gunu rapor sayfasinda 3 kisi listelendi, bilgleri aktar gibi bir dugmeye basildiginda dokum sayfasinda; tebrik kartindan 3 adet koyarak dogum gunu rapor sayfasinda ki ad-soyad, rutbe ve vorev yeri bilgilerini tebrik kartinin ortasinda bulunan kirmizi yerlere yazdiracak. Dosya ekleme konusunda cok ciddi sorun yasiyorum ama yinede tekrar ekleyin diyorsaniz gerekli izinler icin ugrasim. Ilginize tesekkur ederim.

kod:

Sub aktar()

a = MsgBox("aktarmak istiyormuzunız.!?", vbYesNo + vbInformation, " Rapor aktarımı")
If a = vbNo Then
Exit Sub
End If


For i = 5 To Worksheets("DOĞUM GÜNÜ RAPOR").Cells(Rows.Count, "c").End(3).Row
If Sheets("DOĞUM GÜNÜ RAPOR").Cells(i, "c").Value <> "" Then
Sheets("DÖKÜM").Cells(12, "d").Value = Sheets("DOĞUM GÜNÜ RAPOR").Cells(i, "c").Value
Sheets("DÖKÜM").Cells(13, "d").Value = Sheets("DOĞUM GÜNÜ RAPOR").Cells(i, "d").Value
Sheets("DÖKÜM").Cells(14, "d").Value = Sheets("DOĞUM GÜNÜ RAPOR").Cells(i, "b").Value
Sheets("DÖKÜM").PrintOut Copies:=1, Collate:=True
[COLOR="Red"]Application.Wait (Now + TimeValue("00:00:02"))[/COLOR]
End If
Next i

MsgBox " Düzenleme Tamanlanmıştır..."

End Sub

 

[halit3]

Yukarıdaki bölüme iki saniyede yazdırması için bekletme kodu koydum.

 

[montrama]

Ilginize cok tesekkur ederim, sadece dokum sayfasindaki rowlari (1-25 arasi) kopyalayip, her isim icin tek tek ve alt alta yapistirabilirim? Yani 4 isim cikiyorsa alt alta 4 tebrik karti..

 

[halit3]

Ben söylediğinizden bir şey anlamıyorum.
Yukarıdaki iki mesajımda da söylemiştim en iyisi siz döküm sayfası ile ilgili nasıl bir şey istiyorsanız manuel yapın dosyayı da ekleyin bakalım, aksi taktirde ne dediğinizi anlamak için bir sürü mesaj yazmak gerekecek.

 

[montrama]

4-5-6 personelleri icin dokum sayfasini duzenledim..

 

[halit3]

4-5-6 personelleri icin dokum sayfasini duzenledim..

kod:

a = MsgBox("aktarmak istiyormuzunız.!?", vbYesNo + vbInformation, " Rapor aktarımı")
If a = vbNo Then
Exit Sub
End If


For i = 5 To Worksheets("DOĞUM GÜNÜ RAPOR").Cells(Rows.Count, "c").End(3).Row Step 3

Sheets("DÖKÜM").Cells(12, "b").Value = ""
Sheets("DÖKÜM").Cells(13, "b").Value = ""
Sheets("DÖKÜM").Cells(14, "b").Value = ""
Sheets("DÖKÜM").Cells(37, "b").Value = ""
Sheets("DÖKÜM").Cells(38, "b").Value = ""
Sheets("DÖKÜM").Cells(39, "b").Value = ""
Sheets("DÖKÜM").Cells(62, "b").Value = ""
Sheets("DÖKÜM").Cells(63, "b").Value = ""
Sheets("DÖKÜM").Cells(64, "b").Value = ""

If Sheets("DOĞUM GÜNÜ RAPOR").Cells(i, "c").Value <> "" Then
Sheets("DÖKÜM").Cells(12, "b").Value = Sheets("DOĞUM GÜNÜ RAPOR").Cells(i, "c").Value
Sheets("DÖKÜM").Cells(13, "b").Value = Sheets("DOĞUM GÜNÜ RAPOR").Cells(i, "d").Value
Sheets("DÖKÜM").Cells(14, "b").Value = Sheets("DOĞUM GÜNÜ RAPOR").Cells(i, "b").Value
End If

If Sheets("DOĞUM GÜNÜ RAPOR").Cells(i + 1, "c").Value <> "" Then
Sheets("DÖKÜM").Cells(37, "b").Value = Sheets("DOĞUM GÜNÜ RAPOR").Cells(i + 1, "c").Value
Sheets("DÖKÜM").Cells(38, "b").Value = Sheets("DOĞUM GÜNÜ RAPOR").Cells(i + 1, "d").Value
Sheets("DÖKÜM").Cells(39, "b").Value = Sheets("DOĞUM GÜNÜ RAPOR").Cells(i + 1, "b").Value
End If

If Sheets("DOĞUM GÜNÜ RAPOR").Cells(i + 2, "c").Value <> "" Then
Sheets("DÖKÜM").Cells(62, "b").Value = Sheets("DOĞUM GÜNÜ RAPOR").Cells(i + 2, "c").Value
Sheets("DÖKÜM").Cells(63, "b").Value = Sheets("DOĞUM GÜNÜ RAPOR").Cells(i + 2, "d").Value
Sheets("DÖKÜM").Cells(64, "b").Value = Sheets("DOĞUM GÜNÜ RAPOR").Cells(i + 2, "b").Value
End If

Sheets("DÖKÜM").PrintOut Copies:=1, Collate:=True
Application.Wait (Now + TimeValue("00:00:02"))

Next i

MsgBox " Düzenleme Tamanlanmıştır..."

End Sub

 

[montrama]

Ilginize cok tesekkur ederim, biraz degisiklik ile istedigim sonucu elde ettim.. Sonuc dosyasini en yakin zamanda ekleyecem