başka sayfaya devrik dönüşüm yaparak taşımak

[yNsr43]

merhabalar elimdeki kod sayfa1 deki yazılan eşyayi fiyat sayfasinda arayarak giriyor eğer aranan eşya fiyat listesinde yoksa ekliyor ve yanina fiyatı giriyor.
burada değiştirmek istediğim sayfa1 deki B7:B86 araliğini fiyat sayfasindaki eşyanin yanindan başlayarak devrik dönüşüm yaparak yapıştırmasi.
k.Offset(0, 2).Value = Range("B4").Value
kısımını nasıl değiştirebilirz teşekkürler.

Sub fiyatgir()
Dim sh As Worksheet, sonsat As Long
Dim k As Range
Sheets("sayfa1").Select
Set sh = Sheets("fiyat")
sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
Set k = sh.Range("A1:A" & sonsat).Find(Range("A4").Value, , xlValues, xlWhole)

If k Is Nothing Then
sh.Range("A" & sonsat + 1) = Sheets("sayfa1").Range("A4").Value
End If

If Not k Is Nothing Then
    k.Offset(0, 2).Value = Range("B4").Value

End If
End Sub

 

[Ömer]

Merhaba,

k.Offset(0, 2).Value = Range("B4").Value

yerine aşağıdaki kodu deneyin.

Range("B7:B86").Copy
Sh.Cells(k.Row, "B").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Transpose:=True
Application.CutCopyMode = False

 

[yNsr43]

Merhaba,

k.Offset(0, 2).Value = Range("B4").Value

yerine aşağıdaki kodu deneyin.

Range("B7:B86").Copy
Sh.Cells(k.Row, "B").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Transpose:=True
Application.CutCopyMode = False

teşekkürler
şimdi şöyle bir şey oldu ilk çalıştırmada eksik veriyi giriyor ikinci çalıştırmada da fiyatları kopyalayip yapıştırıyor bunu tek çalıştırmada yapmak mümkün mü.
sub cagir()
call fiyatgir
call fiyatgir
end sub geldi aklima ama kodda yapilabilinse daha iyi olur tabi tekrar teşekkürler.

 

[Ömer]

Sorunuzu örnek dosya ile destekleyip detaylı açıklar mısınız.

 

[yNsr43]

Kitap1.xlsm dosyasını indir - download

Kitap1.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

ilk tıklamada sayfa1 a4 deki deki isim fiyat sayfasinda yoksa kopyaliyor ama B7:B86 fiyat bilgilerini kopyalamiyor onun için ikinci sefer tıklama yapmam gerekiyor. teşekkür ederim.

 

[Ömer]

Verdiğim kodları aşağıdaki satırın altına da ekleyin.

sh.Range("A" & sonsat + 1) = Sheets("sayfa1").Range("A4").Value

.