İki Sayfa Arasında Veri Transferi.

[AhmetGuven]

Merhaba,

Yapmak istediğim sayfa1 F sütunundaki bilgileri Sayfa4 (Deneme) sayfasının sayfa1 D sütunundaki adreslerine kopyalamak.
Bir iki makro çalışması yaptım fakat iş biraz uzadı gibi.
Yardımlarınız için Şimdiden Teşekkürler.

Sub Click1()
Application.ScreenUpdating = False
Dim answer As Integer
answer = MsgBox("Doğru Tarihe İşlem Yaptığınıza Emin misin?", vbYesNo + vbQuestion, "İşlem Hakkında!")
If answer = vbYes Then
'---1--- BAŞLA
Sheets("Deneme").Select
Range("A1").Select
On Error Resume Next
Range(Worksheets("Sayfa1").Range("D3").Text).Select
Worksheets("Sayfa1").Range("F3").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("Sayfa1").Select
Application.CutCopyMode = False
On Error GoTo 0
'---1--- SON
'---2--- BAŞLA
Sheets("Deneme").Select
Range("A1").Select
On Error Resume Next
Range(Worksheets("Sayfa1").Range("D4").Text).Select
Worksheets("Sayfa1").Range("F4").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("Sayfa1").Select
Application.CutCopyMode = False
On Error GoTo 0
'---2--- SON
'---3--- BAŞLA
Sheets("Deneme").Select
Range("A1").Select
On Error Resume Next
Range(Worksheets("Sayfa1").Range("D5").Text).Select
Worksheets("Sayfa1").Range("F5").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("Sayfa1").Select
Application.CutCopyMode = False
On Error GoTo 0
'---3--- SON
'---4--- BAŞLA
Sheets("Deneme").Select
Range("A1").Select
On Error Resume Next
Range(Worksheets("Sayfa1").Range("D6").Text).Select
Worksheets("Sayfa1").Range("F6").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("Sayfa1").Select
Application.CutCopyMode = False
On Error GoTo 0
'---4--- SON
'---5--- BAŞLA
Sheets("Deneme").Select
Range("A1").Select
On Error Resume Next
Range(Worksheets("Sayfa1").Range("D7").Text).Select
Worksheets("Sayfa1").Range("F7").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("Sayfa1").Select
Application.CutCopyMode = False
On Error GoTo 0
'---5--- SON
MsgBox "..::.. EVET Butonuna Basıldı - İşlem Yapıldı. ..::..", vbInformation, "Bilgi !"
Else
MsgBox "..::.. HAYIR Butonuna Basıldı - İşlenmedi. ..::..", vbInformation, "Bilgi !"
End If
Application.ScreenUpdating = True
End Sub

 

[AhmetGuven]

Arkadaşlar ,

yardımcı olabilecek kimse yok mu?

 

[muygun]

Merhaba;
Sorunuzu tam anlamamış olabilirim ama bir sayfadan belirtilen sayfada mevcut verinin üzerine ekleme yapmak istiyorsanız eki deneyin.
İyi çalışmalar.

Not:Sayfalarınızı düzenleyebilmek için Ofis2003 formatında yeni sayfa oluşturdum.