Kopyala yapıştır

[numan şamil]

veri alma ve kopyala yapıştır

Merhaba arkadaşlar
Ekte Halit hocamın düzenlediği txt ve tbr dosyalarından excele veri alma ile ilgili dosya (biraz kendi dosyama uydurulmuş hali) var
Benim istediğim Aktar sayfasına aktarılan verileri kopyala yapıştır butonuna basınca kopyala yapıştır sayfasının istediğim hücrelere yapıştırılması (makro ile)
1)Aktar sayfasınının (B1) hücresindeki veri kopyala yapıştır sayfasının (T86 )hücresine
2)Aktar sayfasınının (C1) hücresindeki veri kopyala yapıştır sayfasının (AD86 )ücresine
3)Aktar sayfasınının (D1) hücresindeki veri kopyala yapıştır sayfasının (AO86 )hücresine
4)Aktar sayfasınının (E1) hücresindeki veri kopyala yapıştır sayfasının (AX86 )hücresine
5)Aktar sayfasınının (F1) hücresindeki veri kopyala yapıştır sayfasının (T104) hücresine
6)Aktar sayfasınının (G1) hücresindeki veri kopyala yapıştır sayfasının (T123)hücresine
7)Aktar sayfasınının (H1) hücresindeki veri kopyala yapıştır sayfasının (O35)hücresine
8)Aktar sayfasınının (I1) hücresindeki veri kopyala yapıştır sayfasının (U9)
hücresine yapıştırmak istiyorum
Ekte ilgili hücreler renklendirilmiş ve gelmesi gereken veriler girilmiştir

(Ayrıca örn: Aktar sayfasındaki B1 hücresine gelen veri I1 hücresine I1 hücresine gelen veriyi B1 hücresine almak istersek mevcut kodda ne gibi değişiklik yapmamız gerekiyor Bunu öğrenmek amaçlı soruyorum)
iyi çalışmalar

 

[mancubus]

ben bir kaç satırı ekledim. kalan hücreleri aynı mantıkla siz ekleyin.

Sub KopyalaYapıştır()

Dim wksA As Worksheet, wksKY As Worksheet

Set wksA = Worksheets("Aktar")
Set wksKY = Worksheets("Kopyala yapıştır")

wksKY.Range("T86") = wksA.Range("B1")
wksKY.Range("AD86") = wksA.Range("C1")
wksKY.Range("AO86") = wksA.Range("D1")
'...
'...
'...
'...

End Sub

 

[numan şamil]

Çok teşekkür ederim sn:Mancubus
iyi çalışmalar

 

[mancubus]

rica ederim.

alternatif olarak aşağıdaki kod da kullanılabilir.

Sub ArrHucreKopyala()
    
Dim wksA As Worksheet, wksKY As Worksheet
Dim Arr As Variant
Dim hucre As Range
Dim i As Long
Dim hucreler As String

Set wksA = Worksheets("Aktar")
Set wksKY = Worksheets("Kopyala yapıştır")

hucreler = "T86, AD86, AO86, AX86, T104, T123, O35, U9"

ReDim Arr(1 To wksA.Range(hucreler).Count)

For Each hucre In wksA.Range(hucreler)
    i = i + 1
    Arr(i) = hucre.Value
Next hucre

wksKY.Range("B1:I1") = Arr
    
End Sub