Sayfaya Aktarma

Katılım
13 Haziran 2007
Mesajlar
110
Excel Vers. ve Dili
excel
Arkadaslar
Ekte Yapmak Istedigim Dosya Yer Almaktadir
Yardimci Olursaniz Sevinirim
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Ekli dosyayı inceleyiniz.:cool:
Kod:
Sub sayfalara_aktar()
Dim i As Long, syf, adr1, adr2 As String
Sheets("TELEFON ").Select
On Error GoTo hata
Application.ScreenUpdating = False
For i = 1 To Cells(65536, "C").End(xlUp).Row
    syf = Cells(i, "C").Value
    adr1 = Range(Cells(i, "A"), Cells(i, "J")).Address
    sat = Sheets(syf).Cells(65536, "C").End(xlUp).Row + 1
    adr2 = Range(Cells(sat, "A"), Cells(sat, "J")).Address
    Sheets(syf).Range(adr2).Value = Range(adr1).Value
Next
Application.ScreenUpdating = True
MsgBox "Aktarma tamamlandı..!!", vbOKOnly + vbInformation, "AKTARMA"
Exit Sub
hata:
Application.ScreenUpdating = True
MsgBox "[ " & syf & " ] isimli sayfa bulunamadı." & vbLf & _
"Tamamı aktarılamadı..!!", vbCritical, "UYARI"
End Sub
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,444
Excel Vers. ve Dili
Ofis 365 Türkçe
Arkadaslar Dosya Ekte Yer Almaktadir
SEVGILI ARKADASLAR BU SAYFADAKI BILGILERIN SARI OLARAK BELIRTTIGIMIZ ILE AYNI OLANSAYFALARA AKTARILMASINI İSTİYORUM
Sayın emre1979,

Mesajda açıklama yapmadan dosyayı açmamızı istiyorsunuz, oysa soruyu mesajınıza yazsanız ve ilgisini çekecek olan arkadaş dosyanızı açsa daha çabuk sonuca ulaşırsınız.

Bilgiler sayfaya aktarılırken aktarılan sayfadaki eski bilgiler silinecek mi, yoksa devamına mı aktarılacak?

Yani sadece istiyorum demek olmaz :)
 
Katılım
13 Haziran 2007
Mesajlar
110
Excel Vers. ve Dili
excel
Sayın Necdet Yesertener açıklamalarınız için teşekkürler söylediklerinizde haklısınız
Sayın Orion2 teşekkürler yardımlarınız için
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,444
Excel Vers. ve Dili
Ofis 365 Türkçe
Bende birşeyler yapmıştım :)

İlgili sayfanın olup olmadığını kontrol ettirmedim. Aktarılacak sayfada bilgi varsa devamına aktarılıyor.

Kod:
Public Sub Telefon_Aktar()
On Error Resume Next
Application.ScreenUpdating = False
Set ST = Sheets("TELEFON")
ST.Select
For i = 1 To [A65536].End(3).Row
    SayfaNo = Cells(i, "C")
    j = Sheets(SayfaNo).[A65536].End(3).Row + 1
    Range("A" & i & ":J" & i).Copy Sheets(SayfaNo).Cells(j, "A")
Next i
End Sub
Sayın Orion2'nin sayfa kontrolü şık olmuş. Bilgi vermek gerek tabi :)
 
Katılım
18 Eylül 2004
Mesajlar
15
Bu şekilde yapmak mümkün mü

Hafif bir düzenleme yaptım, bunu visual basicte yapıştırdım, çalıştıramadım, makrodan çalıştıramadım. Nasıl çalıştırabilirim.kodlar aşağıda , başka bir şekilmi düşünmem laızm, bu konuda acemiyim.yardımcı olurmusunuz. dosya ektedir.

Sub sayfalara_aktar()
Dim i As Long, syf, adısoyadi,banka adı, banka yeri, hesap no, brüt ücret, gelirvergisi, damga vergisi, net ücret As String
Sheets("SABİTBİLGİ ").Select
On Error GoTo hata
Application.ScreenUpdating = False
For i = 1 To Cells(65536, "C").End(xlUp).Row
syf = Cells(i, "C").Value
adr1 = Range(Cells(i, "A"), Cells(i, "J")).Address
sat = Sheets(syf).Cells(65536, "C").End(xlUp).Row + 1
adr2 = Range(Cells(sat, "A"), Cells(sat, "J")).Adısoyadı
Sheets(syf).Range(adr2).Value = Range(adr1).Value
Next
Application.ScreenUpdating = True
MsgBox "Aktarma tamamlandı..!!", vbOKOnly + vbInformation, "AKTARMA"
Exit Sub
hata:
Application.ScreenUpdating = True
MsgBox "[ " & syf & " ] isimli sayfa bulunamadı." & vbLf & _
"Tamamı aktarılamadı..!!", vbCritical, "UYARI"
End Sub
 
Üst