Makroyu düğmeye atamak için;

[abbasonline]

Private Sub Worksheet_Activate()
Range("a1").Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set s1 = Sheets("Harita")
Set S2 = Sheets(ActiveSheet.Name)
İL = Cells(Target.Row, 2).Value
Set renk = [M:M].Find(Target.Value, lookat:=xlWhole)
If Not renk Is Nothing Then
rnk = Cells(renk.Row, "m").Interior.ColorIndex
Target.Interior.ColorIndex = rnk
Cells(Target.Row, 2).Interior.ColorIndex = rnk
End If
Set hcr = ActiveCell
Sheets("Harita").Select
ActiveSheet.Shapes(İL).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = rnk + 7
Selection.ShapeRange.Fill.OneColorGradient msoGradientFromCenter, 1, 0.1
S2.Select
hcr.Select
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells(1, 3).Value = Cells(5, 18).Value
Cells(2, 3).Value = Cells(6, 18).Value
Cells(3, 3).Value = Cells(7, 18).Value
Cells(4, 3).Value = Cells(8, 18).Value
Cells(5, 3).Value = Cells(9, 18).Value
Cells(6, 3).Value = Cells(10, 18).Value
Cells(7, 3).Value = Cells(11, 18).Value
Cells(8, 3).Value = Cells(12, 18).Value
Cells(9, 3).Value = Cells(13, 18).Value
Cells(10, 3).Value = Cells(14, 18).Value
Cells(11, 3).Value = Cells(15, 18).Value
Cells(12, 3).Value = Cells(16, 18).Value
Cells(13, 3).Value = Cells(17, 18).Value
Cells(14, 3).Value = Cells(18, 18).Value
Cells(15, 3).Value = Cells(19, 18).Value
Cells(16, 3).Value = Cells(20, 18).Value
Cells(17, 3).Value = Cells(21, 18).Value
Cells(18, 3).Value = Cells(22, 18).Value
Cells(19, 3).Value = Cells(23, 18).Value
Cells(20, 3).Value = Cells(24, 18).Value
Cells(21, 3).Value = Cells(25, 18).Value
Cells(22, 3).Value = Cells(26, 18).Value
Cells(23, 3).Value = Cells(27, 18).Value
Cells(24, 3).Value = Cells(28, 18).Value
Cells(25, 3).Value = Cells(29, 18).Value
Cells(26, 3).Value = Cells(30, 18).Value
Cells(27, 3).Value = Cells(31, 18).Value
Cells(28, 3).Value = Cells(32, 18).Value
Cells(29, 3).Value = Cells(33, 18).Value
Cells(30, 3).Value = Cells(34, 18).Value
Cells(31, 3).Value = Cells(35, 18).Value
Cells(32, 3).Value = Cells(36, 18).Value
Cells(33, 3).Value = Cells(37, 18).Value
Cells(34, 3).Value = Cells(38, 18).Value
Cells(35, 3).Value = Cells(39, 18).Value
Cells(36, 3).Value = Cells(40, 18).Value
Cells(37, 3).Value = Cells(41, 18).Value
Cells(38, 3).Value = Cells(42, 18).Value
Cells(39, 3).Value = Cells(43, 18).Value
Cells(40, 3).Value = Cells(44, 18).Value
Cells(41, 3).Value = Cells(45, 18).Value
Cells(42, 3).Value = Cells(46, 18).Value
End Sub



Bu makro sayfanın herhangi bir hücresine tıkladığımda çalışıyor ancak bir düğme ekledim ve düğmeye tıklayınca çalışmasını istiyorum nasıl bir düzenleme yapmam gerekli.

 

[halit3]

bunu denermisiniz.

Sub deneme1()
b = ActiveWindow.Selection.Column
If b <> 3 Then Exit Sub
Application.ScreenUpdating = False
Set s1 = Sheets("Harita")
Set S2 = Sheets(ActiveSheet.Name)
İL = Cells(ActiveWindow.Selection.Row, 2).Value
Set renk = [M:M].Find(Target.Value, lookat:=xlWhole)
If Not renk Is Nothing Then
rnk = Cells(renk.Row, "m").Interior.ColorIndex
Target.Interior.ColorIndex = rnk
Cells(ActiveWindow.Selection.Row, 2).Interior.ColorIndex = rnk
End If
Set hcr = ActiveCell
Sheets("Harita").Select
ActiveSheet.Shapes(İL).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = rnk + 7
Selection.ShapeRange.Fill.OneColorGradient msoGradientFromCenter, 1, 0.1
S2.Select
hcr.Select
Application.ScreenUpdating = True
End Sub
Sub deneme2()
Cells(1, 3).Value = Cells(5, 18).Value
Cells(2, 3).Value = Cells(6, 18).Value
Cells(3, 3).Value = Cells(7, 18).Value
Cells(4, 3).Value = Cells(8, 18).Value
Cells(5, 3).Value = Cells(9, 18).Value
Cells(6, 3).Value = Cells(10, 18).Value
Cells(7, 3).Value = Cells(11, 18).Value
Cells(8, 3).Value = Cells(12, 18).Value
Cells(9, 3).Value = Cells(13, 18).Value
Cells(10, 3).Value = Cells(14, 18).Value
Cells(11, 3).Value = Cells(15, 18).Value
Cells(12, 3).Value = Cells(16, 18).Value
Cells(13, 3).Value = Cells(17, 18).Value
Cells(14, 3).Value = Cells(18, 18).Value
Cells(15, 3).Value = Cells(19, 18).Value
Cells(16, 3).Value = Cells(20, 18).Value
Cells(17, 3).Value = Cells(21, 18).Value
Cells(18, 3).Value = Cells(22, 18).Value
Cells(19, 3).Value = Cells(23, 18).Value
Cells(20, 3).Value = Cells(24, 18).Value
Cells(21, 3).Value = Cells(25, 18).Value
Cells(22, 3).Value = Cells(26, 18).Value
Cells(23, 3).Value = Cells(27, 18).Value
Cells(24, 3).Value = Cells(28, 18).Value
Cells(25, 3).Value = Cells(29, 18).Value
Cells(26, 3).Value = Cells(30, 18).Value
Cells(27, 3).Value = Cells(31, 18).Value
Cells(28, 3).Value = Cells(32, 18).Value
Cells(29, 3).Value = Cells(33, 18).Value
Cells(30, 3).Value = Cells(34, 18).Value
Cells(31, 3).Value = Cells(35, 18).Value
Cells(32, 3).Value = Cells(36, 18).Value
Cells(33, 3).Value = Cells(37, 18).Value
Cells(34, 3).Value = Cells(38, 18).Value
Cells(35, 3).Value = Cells(39, 18).Value
Cells(36, 3).Value = Cells(40, 18).Value
Cells(37, 3).Value = Cells(41, 18).Value
Cells(38, 3).Value = Cells(42, 18).Value
Cells(39, 3).Value = Cells(43, 18).Value
Cells(40, 3).Value = Cells(44, 18).Value
Cells(41, 3).Value = Cells(45, 18).Value
Cells(42, 3).Value = Cells(46, 18).Value
End Sub