Makro ile düşeyara yapabilirmiyiz

[zehfeysal]

B hücresinden seçim yapınca C hüçresine düseyara ile isimler ve G hücresine otomatik tarih atıyor geliyor sayfadaki veri çogalınca veri yavas gelmeye basladı
makro ile düşeyara yapabilirmiyiz isimleri parametre sayfasından çekecek

 

[spacebar]

Makro kaydet ile yapabilirsiniz. Makro kaydetmeye basın. Formüllü hücreye tıklayıp entere basın. Gerekiyorsa formülü aşağıya çekin. Makro kayıtı durdurun. İşlem tamamdır.

 

[zehfeysal]

makro kaydet işimi görmuyor formul sayfayı kasıyor bir makro buldum uyarlıymadım




Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2:B" & Rows.Count)) Is Nothing Then Exit Sub
Set s1 = Sheets("parametreler")
If Selection > 1 Then Exit Sub
If Target = "" Then Exit Sub
son = s1.Cells(Rows.Count, "e").End(3).Row
If WorksheetFunction.CountIf(s1.Range("E1:E" & son), Target) > 1 Then
MsgBox "Girilen veri birden fazla kayıt içeriyor!", vbCritical
Target.Select
Exit Sub
ElseIf WorksheetFunction.CountIf(s1.Range("E1:E" & son), Target) = 0 Then
MsgBox "Girilen veri bulunamadı!", vbCritical
Target.Select
Exit Sub
Else
a = WorksheetFunction.Match(Target, s1.Range("E1:E" & son), 0)
Target.Offset(0, 1) = s1.Cells(a, "A")
Target.Offset(0, 1) = s1.Cells(a, "f")
End If
End Sub

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz? Kodlar ilgili sayfanın kod bölümünde olmalı.

Sizin kodlarınızı dikkate almadım, ne amaçla yazdığınızı bilmediğimden.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [B:B]) Is Nothing Or Target.Row < 5 Or Target.Value = "" Then Exit Sub
    Dim c As Range
    
    Set c = Sheets("Parametreler").Range("E:E").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        Target.Offset(0, 1) = Sheets("Parametreler").Range("F" & c.Row)
    Else
        Target.Offset(0, 1) = "Bulunamadı.."
    End If
    
End Sub

 

[zehfeysal]

tesekkurler