Makronun Belirtilen Sayfadaki Buton ile Çalışması

[1Al2Ver]

Merhaba,

Modül2' de kayıtlı "GRUPLA" isimli kod, "AKTARILANLAR" sayfasına atanan buton ile işlevini yapmaktadır,

İsteğim,

Bu kodun, "AKTARILANLAR" sayfasında değil,

"LİSTE_PLANLAMA" sayfasında konuşlu bir buton aracılığı ile işlevini yapmasıdır.

Teşekkür ederim.

Sub GRUPLA()

c = MsgBox("M-S  Sütunlarında Otomatik Gruplama Yapılacak" & Chr(10) & Chr(10) & "Onaylıyor musunuz?", vbOKCancel, "Gruplama")
If c = vbCancel Then Exit Sub

Cells(2, 13).Select

Columns("M:S").ClearContents
    
DoEvents
 timer1 = Timer
 Do While Timer - timer1 < 0.1
 Loop
DoEvents

Application.ScreenUpdating = False

sonsatir = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count

Range("M1").Select
ActiveCell.FormulaR1C1 = "GRUP"
Range("N1").Select
ActiveCell.FormulaR1C1 = "GRUP"
Range("O1").Select
ActiveCell.FormulaR1C1 = "GRUP"
Range("P1").Select
ActiveCell.FormulaR1C1 = "GRUP"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "GRUP"
Range("S1").Select
ActiveCell.FormulaR1C1 = "YIL"

Range("M2").Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(INDEX(VERİ_TABANI!R2C2:R351C2,MATCH(RC[-7],VERİ_TABANI!R2C3:R351C3,0)),"""")"
Range("N2").Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(INDEX(VERİ_TABANI!R2C2:R351C2,MATCH(RC[-7],VERİ_TABANI!R2C3:R351C3,0)),"""")"
Range("O2").Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(INDEX(VERİ_TABANI!R2C2:R351C2,MATCH(RC[-7],VERİ_TABANI!R2C3:R351C3,0)),"""")"
Range("P2").Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(INDEX(VERİ_TABANI!R2C2:R351C2,MATCH(RC[-7],VERİ_TABANI!R2C3:R351C3,0)),"""")"
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(INDEX(VERİ_TABANI!R2C2:R351C2,MATCH(RC[-7],VERİ_TABANI!R2C3:R351C3,0)),"""")"
Range("R2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-16]="""","""",TEXT(RC[-16],""aaaa""))"
Range("S2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-17]="""","""",TEXT(RC[-17],""yyyy""))"
Range("M2:S2").Select
Selection.AutoFill Destination:=Range("M2:S" & sonsatir), Type:=xlFillDefault
Range("M2:S" & sonsatir).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Cells(2, 13).Select

Application.ScreenUpdating = True

MsgBox "Gruplama Tamamlandı", , "Gruplama"

End Sub

 

[Ömer]

Merhaba,

Kodları aşağıdakilerle değiştirerek deneyiniz.

Sub GRUPLA()

c = MsgBox("M-S  Sütunlarında Otomatik Gruplama Yapılacak" & Chr(10) & Chr(10) & "Onaylıyor musunuz?", vbOKCancel, "Gruplama")
If c = vbCancel Then Exit Sub

Application.ScreenUpdating = False
Sheets("AKTARILANLAR").Select

Cells(2, 13).Select

Columns("M:S").ClearContents
    
DoEvents
 timer1 = Timer
 Do While Timer - timer1 < 0.1
 Loop
DoEvents

sonsatir = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count

Range("M1").Select
ActiveCell.FormulaR1C1 = "GRUP"
Range("N1").Select
ActiveCell.FormulaR1C1 = "GRUP"
Range("O1").Select
ActiveCell.FormulaR1C1 = "GRUP"
Range("P1").Select
ActiveCell.FormulaR1C1 = "GRUP"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "GRUP"
Range("S1").Select
ActiveCell.FormulaR1C1 = "YIL"

Range("M2").Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(INDEX(VERİ_TABANI!R2C2:R351C2,MATCH(RC[-7],VERİ_TABANI!R2C3:R351C3,0)),"""")"
Range("N2").Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(INDEX(VERİ_TABANI!R2C2:R351C2,MATCH(RC[-7],VERİ_TABANI!R2C3:R351C3,0)),"""")"
Range("O2").Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(INDEX(VERİ_TABANI!R2C2:R351C2,MATCH(RC[-7],VERİ_TABANI!R2C3:R351C3,0)),"""")"
Range("P2").Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(INDEX(VERİ_TABANI!R2C2:R351C2,MATCH(RC[-7],VERİ_TABANI!R2C3:R351C3,0)),"""")"
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(INDEX(VERİ_TABANI!R2C2:R351C2,MATCH(RC[-7],VERİ_TABANI!R2C3:R351C3,0)),"""")"
Range("R2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-16]="""","""",TEXT(RC[-16],""aaaa""))"
Range("S2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-17]="""","""",TEXT(RC[-17],""yyyy""))"
Range("M2:S2").Select
Selection.AutoFill Destination:=Range("M2:S" & sonsatir), Type:=xlFillDefault
Range("M2:S" & sonsatir).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Cells(2, 13).Select

Sheets("LİSTE_PLANLAMA").Select
Application.ScreenUpdating = True

MsgBox "Gruplama Tamamlandı", , "Gruplama"

End Sub

 

[1Al2Ver]

Sayın Ömer merhaba,

Çözüm ve ilginiz için teşekkür ederim, sağ olun.

Sevgi ve saygılarımla.