Veri Aktarımı

[melam]

Şimdiden Teşekkür Ederim

 

[N.Ziya Hiçdurmaz]

Yanıt

Sub AKTAR()
Dim SA As Worksheet
Dim SAY, SUT, S As Long
Set SA = Sheets("ALIMLAR")
For SAY = 2 To Sheets.Count
Sheets(SAY).[A4:G1000].ClearContents
For SUT = 4 To [C65536].End(3).Row
If SA.Range("C" & SUT).Value = Sheets(SAY).Name Then
S = Sheets(SAY).[A65536].End(3).Row
Sheets(SAY).Range("A" & S + 1 & ":G" & S + 1) = SA.Range("A" & SUT & ":G" & SUT).Value
End If
Next
Next
End Sub