(10/06/2019, 14:48)haliliyas yazdı: aşağıdaki gibi düzenleyip dener misiniz?
Public Sub berat()
On Error Resume Next
Dim MyCell As Range, MyRange As Range, deger1 As Range, deger2 As Range, deger3 As Range
Dim intSatir As Integer
Set MyRange = Sheets("Sayfa2").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Set deger1 = Sheets("Sayfa2").Range("B2")
Set deger1 = Range(deger1, deger1.End(xlDown))
Set deger2 = Sheets("Sayfa2").Range("C2")
Set deger2 = Range(deger2, deger2.End(xlDown))
Set deger3 = Sheets("Sayfa2").Range("D2")
Set deger3 = Range(deger3, deger3.End(xlDown))
For Each MyCell In MyRange
Sheets("Sayfa1").Copy After:=Sheets(Sheets.Count)
intSatir = MyCell.Row ' <== eklenen
Sheets(Sheets.Count).Name = MyCell.Value
Sheets(MyCell.Value).ClearContents ' <== eklenen
Sheets(MyCell.Value).Range("b3").Value = Sheets("Sayfa2").Range("B" & intSatir).Value ' <== değişen
Sheets(MyCell.Value).Range("f6").Value = Sheets("Sayfa2").Range("C" & intSatir).Value
Sheets(MyCell.Value).Range("g4").Value = Sheets("Sayfa2").Range("D" & intSatir).Value
Next MyCell
End Sub
Çok teşekkür ederim. Aramadığım yer kalmamıştı. İstediğim gibi değerleri çekiyor.