Veri aktarma

[hbgunay]

Merhaba, veri girişi sayfasında girmiş olduğum verileri ilgili sayfalara makro ile aktarmak istiyorum. Yardımcı olabilir misiniz?

 

[asi_kral]

Merhaba, veri girişi sayfasında girmiş olduğum verileri ilgili sayfalara makro ile aktarmak istiyorum. Yardımcı olabilir misiniz?

Merhaba
Kitabınızın Kod bölümünde bulunan Thisworkbook bölümüne bu kodu kopyalayın ve deneyin.

Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Konu       :   Sayfa Verilerini Aktarma
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
If ActiveSheet.Name = "VERİ GİRİŞİ" Then Exit Sub
Dim s1 As Worksheet, s2 As Worksheet
Dim asi As Range, kral As Variant, a As Long, b As Long
Application.ScreenUpdating = False
Set s1 = Sheets("VERİ GİRİŞİ"): Set s2 = ActiveSheet
s2.Range("A4:E" & Rows.Count).ClearContents
s2.Range("G3:I" & Rows.Count).ClearContents
a = 4: b = 3
Set asi = s1.Range("B:B").Find(ActiveSheet.Name, , , xlWhole)
If Not asi Is Nothing Then
kral = asi.Address
Do
If s1.Cells(asi.Row, "D") = "" And s1.Cells(asi.Row, "E") = "" Then
s2.Cells(a, "A") = s1.Cells(asi.Row, "A")
s2.Cells(a, "B") = s1.Cells(asi.Row, "C")
s2.Cells(a, "C") = s1.Cells(asi.Row, "F")
s2.Cells(a, "D") = s1.Cells(asi.Row, "G")
s2.Cells(a, "E") = s1.Cells(asi.Row, "H")
a = a + 1
Else
s2.Cells(b, "G") = s1.Cells(asi.Row, "A")
s2.Cells(b, "H") = s1.Cells(asi.Row, "D")
s2.Cells(b, "I") = s1.Cells(asi.Row, "E")
b = b + 1: End If
Set asi = s1.Range("B:B").FindNext(asi)
Loop While Not asi Is Nothing And asi.Address <> kral
End If
Application.ScreenUpdating = True
MsgBox ActiveSheet.Name & " Sayfa Verileri Aktarıldı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Dosyanız Ekte.

 

[baydeniro]

Çok teşekkürler sayın asi_kral_1967. Çok çok yararlı bir kod. Sağlıcakla kalın.

 

[asi_kral]

Çok teşekkürler sayın asi_kral_1967. Çok çok yararlı bir kod. Sağlıcakla kalın.

Kolay Gelsin.

 

[hbgunay]

Bir türlü bunu dosyaya kaydedemedim. Rica etsem siz ekleyip gönderebilir misiniz?

 

[asi_kral]

Bir türlü bunu dosyaya kaydedemedim. Rica etsem siz ekleyip gönderebilir misiniz?

1. Dosya ekli görmediniz sanırım.
2. İse Farklı Kaydet'ten makro içerebilen dosya şeklinde kayıt yapmalısınız.
3. İse Güvenlik ayarları ile oynamalısınız. Uygulamalı Excel'de bilgiler mevcut

 

[hbgunay]

Excel 2010'a yeni geçtim. Bugüne kadar hep 2003 kullanıyordum. Menülerin yeri çok değişmiş. Kendi dosyama formülleri bir türlü ekleyemedim, ama sizin dosyanızdan işleme devam ettim. Emeğinize teşekkür ederim.

 

[asi_kral]

Excel 2010'a yeni geçtim. Bugüne kadar hep 2003 kullanıyordum. Menülerin yeri çok değişmiş. Kendi dosyama formülleri bir türlü ekleyemedim, ama sizin dosyanızdan işleme devam ettim. Emeğinize teşekkür ederim.

Kolay Gelsin.

 

[gokhanbek]

hocam kolay gelsin
yapıştırma yaparken formülleride yapıştırıyor. değerleri yapıştır nasıl deriz.
birde benim yapmak istedigim hücre isimlerini vererek yapıştırsın mümkünmü?
a2-a sutunu
b3-b sutunu
c9-c
c8-d...
gibi

 

[asi_kral]

hocam kolay gelsin
yapıştırma yaparken formülleride yapıştırıyor. değerleri yapıştır nasıl deriz.
birde benim yapmak istedigim hücre isimlerini vererek yapıştırsın mümkünmü?
a2-a sutunu
b3-b sutunu
c9-c
c8-d...
gibi

Merhaba

Range("AA:AA").Copy
Range("A2").PasteSpecial (xlPasteValues)

Bu şekilde olabilir.
Sadece bir örnek