Makro kaydı yaptım yavaş çalışıyor

[puslukurt]

Merhaba arkadaşlar;
Yapmış olduğum makro kaydım aşağıdadır. bu makro istediğim gibi çalışıyor lakin hem yavaş çalışıyor hem de çalışırken (M3:R22) hücrelerinde yapılan işlemler görünüyor. acaba bu kodu başka metot ile hem hızlı hem de (M3:R22) hücrelerinde yapılan işlemler görünmeden yapabilir miyiz. şimdiden bütün arakadaşalara teşekkür ederim

Sub Makro1()

Range("B3:G22").Select
Selection.Copy
Range("M3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("O321").Select
Selection.Copy
Range("B4").Select
ActiveSheet.Paste
Range("O2222").Select
Application.CutCopyMode = False
Selection.Copy
Range("B3").Select
ActiveSheet.Paste
Range("M3:N21").Select
Application.CutCopyMode = False
Selection.Copy
Range("F4").Select
ActiveSheet.Paste
Range("M22:N22").Select
Application.CutCopyMode = False
Selection.Copy
Range("F3").Select
ActiveSheet.Paste
Range("Q3:R21").Select
Application.CutCopyMode = False
Selection.Copy
Range("D4").Select
ActiveSheet.Paste
Range("Q22:R22").Select
Application.CutCopyMode = False
Selection.Copy
Range("D3").Select
ActiveSheet.Paste
Columns("M:R").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("O6").Select
End Sub

 

[alicimri]

Aşağıdaki gibi deneyin.

Sub Makro1()
Range("B3:G22").Copy Range("M3")
Range("O3:p21").Copy Range("B4")
Range("O22:p22").Copy Range("B3")
Range("M3:N21").Copy Range("F4")
Range("M22:N22").Copy Range("F3")
Range("Q3:R21").Copy Range("D4")
Range("Q22:R22").Copy Range("D3")
Columns("M:R").Delete Shift:=xlToLeft
End Sub

 

[puslukurt]

teşekkür ederim alicimri bey makro hızlandı sadece m3:r22 hücresinde yapılan işlemler görünüyor

 

[Korhan Ayhan]

Makronun başına;

Application.ScreenUpdating = False

Makronun sonuna;

Application.ScreenUpdating = True

Eklerseniz işlemler sırasında ekran hareketleri gözükmez.

Application.ScreenUpdating property (Excel)

Office VBA reference topic

learn.microsoft.com

 

[alicimri]

Bu kodlarla ne yapmak istediğinizi anlamadım, yapıştırma işlemlerinden sonra işlem yapılan hücreler siliniyor
Yöntemi anlatmak için kodları örnekledim.

 

[puslukurt]

Ali bey şöyleki .....
(B3:G22) arasında personel listesi var bu personel listesini 3 vardiya döndürmeye çalışıyorum. önce B3:G22 arasındaki listeyi kopyalayıp m3 hücresine yapıştırıyorum. sonra bu m3 hücresinden bir satır aşağıya kaydırmak suretiyle B4:C22 hücresine yapıştırıyorum birde en altta kalan personelleri b3 hücresine yapıştırıyorum bu döngüyü diger hücreler içinde yapıyorum. yapıştırma işlemleri silinmesinin sebebine gelince m3 ve devamındaki verilerin bir hükmü kalmiyor çünki her defasında gerçek değerler b3 hücresine yapıştırma işlemi gerçekleştikten sonra gerçek değer onlar olmuş oluyor biraz karıştı umarım anlamışsınızdır. bir başka kod daha vardı onu kullanıyordum şimdi personel fazlalaştığı için kodları bilemediğim için böyle bişey yaptım olmassa ben bir de o kodları aşağıya yazayım

Sub Düğme1_Tıklat()
Dim a As Integer
If [F3] > 0 And [F3] < 21 Then
Range("F7").Select
If MsgBox("Bir sonraki Vardiya Listesi hazırlansın mı?", vbYesNo, "Onay kutusu") = vbYes Then
For a = [F3] To 1 Step -1
Cells(a + 3, 2) = Cells(a + 2, 3)
Cells(a + 3, 3) = Cells(a + 2, 4)
Cells(a + 3, 4) = Cells(a + 2, 2)
Next a
For a = 2 To 4
Cells(3, a) = Cells([F3] + 3, a)
Next a
[B23] = [B24]
[B24] = [C24]
[C24] = [D24]
[D24] = [B23]
[B23] = ""
For a = 2 To 4
Cells([F3] + 3, a) = ""
Next a
ElseIf MsgBox("Bir önceki Vardiya Listesine geri dönülsün mü?", vbYesNo, "Onay kutusu") = vbYes Then
For a = 2 To 4
Cells([F3] + 3, a) = Cells(3, a)
Next a
For a = 1 To [F13]
Cells(a + 2, 2) = Cells(a + 3, 4)
Cells(a + 2, 3) = Cells(a + 3, 2)
Cells(a + 2, 4) = Cells(a + 3, 3)
Next a
[B23] = [B24]
[B24] = [C24]
[C24] = [D24]
[D24] = [B23]
[B23] = ""
For a = 2 To 4
Cells([F3] + 3, a) = ""
Next a
End If
Else: MsgBox ("Lütfen Kantar satısını 1-20 arası girin")
End If
End Sub

bu kodlar çok güzeldi lakin b3 den sonra birer sutun eklemem gerekti bu da beceremedim siz yaparsınız bir bakın teşekkür ederim ilginize

 

[alicimri]

tcdosya gibi bir paylaşım sitesine örnek dosya ekleyip, link verirseniz, daha çabuk yardım alabilirsiniz.

 

[puslukurt]

anladım teşekkür ederim Ali bey