şablon oluşturma

[muratkul]

Merhaba,
ekteki göndermiş olduğum excel dosyasında sheet 1 de sabit bir şablon var. shet 3 de benim verilerim mevcut.shet1 e n1 deki gibi fatura numarasını yazdığım zaman ilgili alanları sheet3 den alarak otomatik shet1 deki uygun yerlere yazmasını istiyorum

 

[Orion1]

Merhaba,
ekteki göndermiş olduğum excel dosyasında sheet 1 de sabit bir şablon var. shet 3 de benim verilerim mevcut.shet1 e n1 deki gibi fatura numarasını yazdığım zaman ilgili alanları sheet3 den alarak otomatik shet1 deki uygun yerlere yazmasını istiyorum

sheet3e 4-5 satır veri girerek dosyanızı tekrar yükleyiniz.
Böyle kodlar denenemez.Hata olmuşmu diye deniyoruz biz kodları.

 

[muratkul]

merhaba,shet 3 te veri mevcut. Veriler H sütunundan başlıyor efendim.

 

[Orion1]

Bazı başlıklar sheet3 te yok.
Dosyanız ektedir.

Sub aktar59()
Dim sh As Worksheet, sonsat As Long, k As Range, adr As String, sat As Long
Sheets("Sheet1").Select
Range("A2:M" & Rows.Count).ClearContents
Set sh = Sheets("Sheet3")
sonsat = sh.Cells(Rows.Count, "I").End(xlUp).Row
sat = 2
Application.ScreenUpdating = False
Set k = sh.Range("I2:I" & sonsat).Find(Range("N1").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        Cells(sat, "A").Value = CStr(sh.Cells(k.Row, "K").Value)
        Cells(sat, "B").Value = sh.Cells(k.Row, "M").Value
        Cells(sat, "C").Value = sh.Cells(k.Row, "P").Value
        Cells(sat, "D").Value = sh.Cells(k.Row, "Q").Value
        Cells(sat, "E").Value = sh.Cells(k.Row, "Z").Value
        Cells(sat, "H").Value = sh.Cells(k.Row, "AC").Value
        Cells(sat, "I").Value = sh.Cells(k.Row, "AD").Value
        sat = sat + 1
        Set k = sh.Range("I2:I" & sonsat).FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
End If
Application.ScreenUpdating = True
Set sh = Nothing
Set k = Nothing
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[muratkul]

çok teşekkür ederim evren bey.

 

[muratkul]

Evren bey, Sheet3 deki ürün kodunu sheet1 ede metin gibi görmesini sağlayabilir misiniz.

 

[Orion1]

Evren bey, Sheet3 deki ürün kodunu sheet1 ede metin gibi görmesini sağlayabilir misiniz.

Dosyayı 4 nolu mesajda güncelledim.
Oradan indirebilirsiniz.

 

[muratkul]

çok sağolun evren bey.

 

[Orion1]

çok sağolun evren bey.

Rica ederim.
İyi çalışmalar.