verileri belli kriterlere göre belli alanlara aktarma

[hdemirc_]

üretim sayfasındaki verileri üretim programına belirli kriterlere göre aktarma

 

[Ferhat Pazarçevirdi]

Aşadakileri, standart bir modül sayfasına kopyalayıp çalıştırınız.

Sub Uretim_Programi_Olustur()
Dim shU As Worksheet
Dim shP As Worksheet
Dim bul As Range
Dim yaz As Range
Dim i As Integer, sonP As Integer
Set shU = Sheets("ÜRETİM")
Set shP = Sheets("ÜRETİM PROGRAMI")
shP.Range("C4:Q37").ClearContents
For i = 3 To shU.Cells(65536, 1).End(xlUp).Row
    If shU.Cells(i, "E") <> Empty Then
       Set bul = shP.Rows(3).Find(shU.Cells(i, "F"), lookat:=xlWhole)
       If Not bul Is Nothing Then
            sonP = shP.Cells(65536, bul.Column).End(xlUp).Row + 1
            Set yaz = shP.Cells(sonP, bul.Column)
            
            yaz = shU.Cells(i, 1)
            yaz.Offset(0, 1) = shU.Cells(i, 2)
            yaz.Offset(1, 0) = shU.Cells(i, 4)
            yaz.Offset(1, 1) = shU.Cells(i, 3)
       End If
    End If
Next i
Set bul = Nothing
Set yaz = Nothing
Set shU = Nothing
Set shP = Nothing
End Sub

 

[limanC34]

Sayın Ferhat Pazarçevirdi
Hernekadar bana yollanmadıysa bile emeğinize kayıtsız kalamadım işime baya bir yarayacak.
Teşekkür ederim.

 

[hdemirc_]

Süper hocam ya
ellerine sağlık. gerçekten çok işime yarayacak. günlerdir uğraştım makro kaydederek yaptım ama çok uzun ve verimsiz bir kod olmuştu. bu harika olmuş
tekrar teşekürlerimi sunuyorum. sağolasın