Makro kodlama

[recepkull]

Arkadaşlar yine bir makro koduyla ilgili yardımınıza ihtiyacım var. Sorunumu aşağıdaki örnek dosyada açıkladım. Yardımlarınız için şimdiden teşekkürler.
https://www.dosyaupload.com/ejSb

 

[Cengiz Demir]

Bu kodlar işinizi görür sanırım

Sub veri()
Dim syf As String

syf = Cells(2, 4)
kyt = Cells(3, 4)

Select Case kyt
    Case Is = 1
    i = "B": y = "D"
    Case Is = 2
    i = "F": y = "H"
    Case Is = 3
    i = "J": y = "L"
    Case Is = 4
    i = "N": y = "P"
    Case Is = 5
    i = "R": y = "T"
End Select

hcr = i & "3" & ":" & y & "11"
Sheets(syf).Range(hcr).Value = Sheets("Veri").Range("B3:D11").Value

End Sub

 

[hamitcan]

Böyle deneyin.

Sub Kopyala()
    Syf = CStr(Sheets("Kaydet").[d2])
    Set x = Sheets(Syf).Rows(2).Find(Sheets(Syf).[d3] & "*")
    Sheets("Veri").[b3:d11].Copy
    Sheets(Syf).Cells(2, x.Column).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

 

[recepkull]

Bu kodlar işinizi görür sanırım

Sub veri()
Dim syf As String

syf = Cells(2, 4)
kyt = Cells(3, 4)

Select Case kyt
    Case Is = 1
    i = "B": y = "D"
    Case Is = 2
    i = "F": y = "H"
    Case Is = 3
    i = "J": y = "L"
    Case Is = 4
    i = "N": y = "P"
    Case Is = 5
    i = "R": y = "T"
End Select

hcr = i & "3" & ":" & y & "11"
Sheets(syf).Range(hcr).Value = Sheets("Veri").Range("B3:D11").Value

End Sub

@cengizdemir72 hocam Makroyu çalıştırdığımda bütün satır ve sütunlarda #YOK hatası çıkıyor. Bütün satır ve sütunları siliyorum daha sonra aynı sayfaa aynı kayıt alanı için makroyu tekrar çalıştırıyorum bu sefer hatasız çalışıyor. Yani bazen bütün satır ve sütünlarda #YOK hatası çıkıyor bazende sorunsuz çalışıyor anlayamadım

 

[recepkull]

@hamitcan hocam debug hatası veriyor.

 

[Cengiz Demir]

@recepkull
İlginç; sizin dosyanızda biraz deneme yaptımıştım ve sorun çıkartmamıştı.

Az önce denedim yine sorun çıkmadı. Acaba gerçek dosya da mı sorun çıkartıyor.

Dosyayı ekledim
http://dosya.co/7pplyh11a40s/aaa1.xlsm.html

Ek :

Hamitcan üstadın makrosunu da denedim.

Debug hatası vermedi ama verileri farklı yere yapıştırıyordu.
Find(Sheets("Kaydet")
Sheets(syf).Cells(3

Düzeltmelerini yapınca şu anda o makro da örnek dosyada düzgün çalışıyor.

Sub Kopyala()
    syf = CStr(Sheets("Kaydet").[d2])
    Set x = Sheets(syf).Rows(2).Find(Sheets("Kaydet").[d3] & "*")
    Sheets("Veri").[b3:d11].Copy
    Sheets(syf).Cells(3, x.Column).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

 

[recepkull]

Galiba benim dosyada sıkıntı varmış. Linki indirdim sorunsuz çalışıyor. Teşekkür ederim yardımlarınız için.

 

[Cengiz Demir]

Rica ederim

Galiba benim dosyada sıkıntı varmış. Linki indirdim sorunsuz çalışıyor. Teşekkür ederim yardımlarınız için.