Macroda belirlenen hücreyi aratmak

[Orion1]

çok teşekkür ederim hocam eline sağlık

Rica ederim.
İyi çalışmalar.

 

[yNsr43]

hocam son bişey daha soracam B4 harıcında farkli hücreleride kopyalamak istediğimizde kodun iskeleti çöküyor mu yoksa

   deg3 = ActiveWorkbook.Sheets(1).Range("f3").Value
    ActiveWorkbook.Close False
    Set k = Range("A1:A" & sonsat).Find(deg, , xlValues, xlWhole)
    If Not k Is Nothing Then k.Offset(0, 2).Value = deg3

ekleyerekte yapabiliyormuyuz ki denedim yapamiyormuşuz

 

[yNsr43]

pardon hocam yanlış alarm

Do While dosya <> ""
    Application.DisplayAlerts = False
    If Workbooks.Open(Yol & dosya).ReadOnly = True Then Workbooks(dosya).Close True
    Application.DisplayAlerts = True
    deg = ActiveWorkbook.Sheets(1).Range("A4").Value
    deg2 = ActiveWorkbook.Sheets(1).Range("B4").Value
    deg3 = ActiveWorkbook.Sheets(1).Range("d4").Value
    deg4 = ActiveWorkbook.Sheets(1).Range("d6").Value
    deg5 = ActiveWorkbook.Sheets(1).Range("e6").Value
    ActiveWorkbook.Close False
    Set k = Range("A1:A" & sonsat).Find(deg, , xlValues, xlWhole)
    If Not k Is Nothing Then k.Offset(0, 1).Value = deg2
    If Not k Is Nothing Then k.Offset(0, 2).Value = deg3
    If Not k Is Nothing Then k.Offset(0, 3).Value = deg4
    If Not k Is Nothing Then k.Offset(0, 4).Value = deg5
    dosya = Dir
Loop

böyle yapınca oluyormuş genede teşekkür ederim

 

[Orion1]

Sadeleştirelim.

If Not k Is Nothing Then
    k.Offset(0, 1).Value = deg2
    k.Offset(0, 2).Value = deg3
    k.Offset(0, 3).Value = deg4
    k.Offset(0, 4).Value = deg5
End If

 

[yNsr43]

eywallah hocam