Kodda Sadeleştirme

[1Al2Ver]

Merhaba,

Aşağıdaki, "Makro Kaydet" yöntemi ile alınan kodu sadeleştirme, başka bir ifade ile kısaltma ve olabiliyor ise, koda daha hızlı işlevsellik kazandırmak için
yardımlarınızı rica ediyorum,

Teşekkür ederim.

Sub HAFTALIK_YAPITAŞI()

    Range("F2:F50").Select
    Selection.Copy
    Sheets("HAFTALIK_YAPITAŞI").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("HAFTALIK_LİSTE").Select
    Range("G2:G50").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("HAFTALIK_YAPITAŞI").Select
    Range("B51").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=37
    
    Sheets("HAFTALIK_LİSTE").Select
    Range("H2:H50").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("HAFTALIK_YAPITAŞI").Select
    Range("B100").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=50
    
    Sheets("HAFTALIK_LİSTE").Select
    Range("I2:I50").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("HAFTALIK_YAPITAŞI").Select
    Range("B149").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=48
    
    Sheets("HAFTALIK_LİSTE").Select
    Range("J2:J50").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("HAFTALIK_YAPITAŞI").Select
    Range("B198").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("HAFTALIK_LİSTE").Select
    Range("F2").Select
    
End Sub

 

[ÖmerBey]

Merhaba,
Buyurunuz...

Sub HAFTALIK_YAPITAŞI()
    Set HY = Sheets("HAFTALIK_YAPITAŞI")
    Set HL = Sheets("HAFTALIK_LİSTE")
    Application.ScreenUpdating = False
    HL.Range("F2:F50").Copy
    HY.Range("B2").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    HY.Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
    HL.Range("G2:G50").Copy
    HY.Range("B51").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    HY.Range("B51").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    HL.Range("H2:H50").Copy
    HY.Range("B100").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    HY.Range("B100").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

   
    HL.Range("I2:I50").Copy
    HY.Range("B149").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    HY.Range("B149").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    HL.Range("J2:J50").Copy
    HY.Range("B198").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    HY.Range("B198").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    HL.Select
    Range("F2").Select
    Application.ScreenUpdating = True
End Sub

 

[1Al2Ver]

Sayın ÖmerBey merhaba,

Gösterdiğiniz ilgi ve sunduğunuz çözüm için teşekkür ederim, sağ olun.

Sevgi ve saygılarımla.