Makro Kodunu Kısaltmak Mümkün mü?

[3641]

Aşağıdaki kodu veri çekmek için Excell içinde yaklaşık 40 sayfada kullanıyorum.
Tüm verilerim "Liste" sayfasında bulunuyor, Veriyi çekeceğim sayfada ise aşağıdaki kod mevcut,
Sayfa sayısı artınca kodun çalışması yavaşlıyor,

Kodu nasıl düzenlersem daha hızlı ve verimli çalışır acaba.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim S1 As Worksheet, S2 As Worksheet, BUL As Range

On Error GoTo Son
If Intersect(Target, Range("A3:A200")) Is Nothing Then Exit Sub

Set S1 = Sheets("Veri_Al_Sayfa1")
Set S2 = Sheets("liste")

If Target <> "" Then
Set BUL = S2.Range("A:A").Find(Target, LookAt:=xlWhole)
If Not BUL Is Nothing Then
Cells(Target.Row, "B") = BUL.Offset(0, 1)
Cells(Target.Row, "C") = BUL.Offset(0, 2)
Cells(Target.Row, "D") = BUL.Offset(0, 3)
Cells(Target.Row, "E") = BUL.Offset(0, 4)
Cells(Target.Row, "G") = BUL.Offset(0, 6)
Cells(Target.Row, "I") = BUL.Offset(0, 8)
Cells(Target.Row, "K") = BUL.Offset(0, 10)
End If
Else
Cells(Target.Row, "B") = ""
Cells(Target.Row, "C") = ""
Cells(Target.Row, "D") = ""
Cells(Target.Row, "E") = ""
Cells(Target.Row, "G") = ""
Cells(Target.Row, "I") = ""
Cells(Target.Row, "K") = ""
End If

Son:
Set S1 = Nothing
Set S2 = Nothing
End Sub

 

[numan şamil]

Merhaba
Sorunuzu birkaç sayfalık bir örnek dosya ile ve çalışma sistemi ile alakalı biraz daha açıklama yaparsanız yardımcı olacak arkadaşlar çıkacaktır