Makro ile Kopyala Yapıştır.

[mhrcvk]

Arkadaşlar Merhaba,

Ben bir butona atayacağım makro yardımı ile o butona tıkladığımda g3:g183 ve h3:h183 aralığını kopyalayıp g3:g183 arasını e3:e183'e h3:h183 arasını ise f3:f183 arasına değer olarak yapıştırmak istiyorum yardımcı olabilir misiniz ?

 

[yanginci34]

Merhaba; kopyalanacak alanlarda formüllü yer varmı, g3:g183 ve h3:h183 sabitmi? bunlar kodun yapısını değiştirir siz örnek bir dosya gönderirseniz yardımcı olmak daha kolay olacaktır.

 

[mhrcvk]

Merhaba; kopyalanacak alanlarda formüllü yer varmı, g3:g183 ve h3:h183 sabitmi? bunlar kodun yapısını değiştirir siz örnek bir dosya gönderirseniz yardımcı olmak daha kolay olacaktır.

Mesajı düzenledim fakat g ve h sütünlarında asıl kullanacağım tabloda formül mevcut bilgi notu olarak belirtmek istedim.

 

[yanginci34]

Merhaba; butona basmadan evvel g3 hücresi seçili olmasına dikkat edin. Denermisiniz?
Ekli dosyayı görüntüle kop. yapıştır.xlsm

 

[mhrcvk]

İlginiz için çok teşekkür ederim işimi gördü.

Fakat ben bu makroyu farklı alanlarda da aynı işlev için kullanmak istediğimde nasıl bir değişiklik yapmam gerekiyor bu konuda da yardımcı olabilir misiniz ?

 

[yanginci34]

Bu makroyu ben makro kaydet yöntemi ile hazırladım açıklamak konusunda zayıfım ama orjinal dosyanızı gönderme şansınız varsa onada aynı işlemi yapabiliriz.

 

[mhrcvk]

Bu makroyu ben makro kaydet yöntemi ile hazırladım açıklamak konusunda zayıfım ama orjinal dosyanızı gönderme şansınız varsa onada aynı işlemi yapabiliriz.

https://drive.google.com/file/d/0B_O...ew?usp=sharing

Dosyanın Orginal çakması budur. Burada Yapmış olduğunuz işleme ek olarak aj3:aj183 arasındeki verileride değer olarak ag3:ag183 arasına yapıştırması gerekiyor.

 

[yanginci34]

Dosya silinmiş galiba indiremedim bir kontrol eder misiniz acaba

 

[mhrcvk]

Dosya silinmiş galiba indiremedim bir kontrol eder misiniz acaba

https://drive.google.com/open?id=0B_OZGQg__A02b0hhNDZIZXlvNlU

Güncelledim.

 

[yanginci34]

Aşağıdaki kodun kırmızı yerlerini kendi dosyanıza göre uyarlayıp denermisiniz?

Sub eee()
'
' eee Makro
'

'
Sheets("Sayfa1").Range("g3:g183").Select
Selection.Copy
Sheets("Sayfa1").Range("e3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-12
ActiveCell.Offset(0, 3).Range("A1").Select
Application.CutCopyMode = False
Call ern
End Sub
Sub ern()
'
' ern Makro
'

'
Sheets("Sayfa1").Range("h3:h183").Select
Selection.Copy
Sheets("Sayfa1").Range("f3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-21
ActiveCell.Offset(0, 2).Range("A1").Select
Application.CutCopyMode = False
End Sub

 

[askm]

Aşağıda kısa olarak kodlar ve açıklamaları aşağıdadır.

Sub askm_kopyala() 'Prosedur başlangıcı
Application.ScreenUpdating = False
Application.EnableEvents = False 'işlemi hızlı yapması için uyazıldı.

Sonkayit = Range("H65000").End(xlUp).Row 'H sütunundaki son kayıdı bulduk
Range("H3:H" & Sonkayit).Copy 'H3 ile H sütunundaki son kayıt arasını Hafızaya kopyaladık

Range("F3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        'Seçili alanı değer olarak F3 den itibaren yapıştırdık

Application.ScreenUpdating = True 'işlemi hızlı yapması için uyazıldı.
Application.EnableEvents = True
End Sub 'Prosedur sonu

 

[yanginci34]

Aşağıda kısa olarak kodlar ve açıklamaları aşağıdadır.

Sub askm_kopyala() 'Prosedur başlangıcı
Application.ScreenUpdating = False
Application.EnableEvents = False 'işlemi hızlı yapması için uyazıldı.

Sonkayit = Range("H65000").End(xlUp).Row 'H sütunundaki son kayıdı bulduk
Range("H3:H" & Sonkayit).Copy 'H3 ile H sütunundaki son kayıt arasını Hafızaya kopyaladık

Range("F3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        'Seçili alanı değer olarak F3 den itibaren yapıştırdık

Application.ScreenUpdating = True 'işlemi hızlı yapması için uyazıldı.
Application.EnableEvents = True
End Sub 'Prosedur sonu

Birde kodunuzun altına aşağıdaki eklenirse süper yazmışsınız üstadım elinize beyninize sağlık.
Application.CutCopyMode = False

 

[mhrcvk]

tşk

Aşağıdaki kodun kırmızı yerlerini kendi dosyanıza göre uyarlayıp denermisiniz?

Sub eee()
'
' eee Makro
'

'
Sheets("Sayfa1").Range("g3:g183").Select
Selection.Copy
Sheets("Sayfa1").Range("e3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-12
ActiveCell.Offset(0, 3).Range("A1").Select
Application.CutCopyMode = False
Call ern
End Sub
Sub ern()
'
' ern Makro
'

'
Sheets("Sayfa1").Range("h3:h183").Select
Selection.Copy
Sheets("Sayfa1").Range("f3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-21
ActiveCell.Offset(0, 2).Range("A1").Select
Application.CutCopyMode = False
End Sub

Bu tam işimi gördü ek olarak istediğim gibi revize edebiliyor olmamda güzel Elinize emeğinize sağlık.

 

[mhrcvk]

tşk

Aşağıda kısa olarak kodlar ve açıklamaları aşağıdadır.

Sub askm_kopyala() 'Prosedur başlangıcı
Application.ScreenUpdating = False
Application.EnableEvents = False 'işlemi hızlı yapması için uyazıldı.

Sonkayit = Range("H65000").End(xlUp).Row 'H sütunundaki son kayıdı bulduk
Range("H3:H" & Sonkayit).Copy 'H3 ile H sütunundaki son kayıt arasını Hafızaya kopyaladık

Range("F3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        'Seçili alanı değer olarak F3 den itibaren yapıştırdık

Application.ScreenUpdating = True 'işlemi hızlı yapması için uyazıldı.
Application.EnableEvents = True
End Sub 'Prosedur sonu

Emeğinize sağlık özellikle açıklaması olması çok hoş olmuş teşşekkür ederim.