İki macroyu tek Tuşa atamak

[cemshan]

Merhaba arkadaşlar.

2 Adet Kod yazdım. Bunları tek tuşla ikisini aynı anda çalıştıra bilirmiyim?

Sub dsyara()

Dim x1 As Worksheet
Dim x2 As Worksheet

Set x1 = Sheets("Data")
Set x2 = Sheets("Veri")

x1.Range("a2:a5000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c5000"), x2.Range("a:j"), 4, 0), "")
x1.Range("l2:l5000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c5000"), x2.Range("a:j"), 10, 0), "")
x1.Range("j2:j5000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c5000"), x2.Range("a:j"), 3, 0), "")
x1.Range("k2:k5000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c5000"), x2.Range("a:j"), 5, 0), "")

End Sub

Sub carp()

With Sheets("Data").Range("h2:h5000")
.Formula = "=Data!f2*Data!k2"
.Value = .Value
End With

With Sheets("Data").Range("I2:I5000")
.Formula = "=Data!G2*Data!k2"
.Value = .Value
End With


End Sub

 

[dEdE]

Merhaba,
Üçüncü makro ile;

Sub Tek_Tus()
    Call dsyara
    Call carp
End Sub

Veya ilk çalışacak kodun son satırından önce ikinci makronun adını yazarak;

Sub dsyara()

Dim x1 As Worksheet
Dim x2 As Worksheet

Set x1 = Sheets("Data")
Set x2 = Sheets("Veri")

x1.Range("a2:a5000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c5000"), x2.Range("a:j"), 4, 0), "")
x1.Range("l2:l5000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c5000"), x2.Range("a:j"), 10, 0), "")
x1.Range("j2:j5000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c5000"), x2.Range("a:j"), 3, 0), "")
x1.Range("k2:k5000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c5000"), x2.Range("a:j"), 5, 0), "")
   
Call carp

End Sub

 

[RBozkurt]

Aşağıdaki işlevi bir örneğin butona atarsanız makrolar aynı anda çalışmaz ama tek tıkarsınız yazılan sıra ile ikisi de çalışır.

Sub Makrolar()
     Call dsyara 
     Call carp
End Sub

 

[cemshan]

Merhaba,
Üçüncü makro ile;

Sub Tek_Tus()
    Call dsyara
    Call carp
End Sub

Veya ilk çalışacak kodun son satırından önce ikinci makronun adını yazarak;

Sub dsyara()

Dim x1 As Worksheet
Dim x2 As Worksheet

Set x1 = Sheets("Data")
Set x2 = Sheets("Veri")

x1.Range("a2:a5000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c5000"), x2.Range("a:j"), 4, 0), "")
x1.Range("l2:l5000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c5000"), x2.Range("a:j"), 10, 0), "")
x1.Range("j2:j5000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c5000"), x2.Range("a:j"), 3, 0), "")
x1.Range("k2:k5000") = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x1.Range("c2:c5000"), x2.Range("a:j"), 5, 0), "")
  
Call carp

End Sub

Teşekkür ederim . Çalışıyor. Elinize sağlık