- Katılım
- 20 Haziran 2016
- Mesajlar
- 11
- Excel Vers. ve Dili
- 2013 - Türkçe
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).Selec t
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).Selec t
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).Selec t
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).Selec t
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).Selec t
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
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).Selec t
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).Selec t
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).Selec t
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).Selec t
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).Selec t
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
Ekli dosyalar
Son düzenleme:
