Soru Şartlı Veri Aktar

[Hsn55]

Merhabalar;
Ekli dosyada ver girişi sayfasında J21 hücresindeki m3 dolu ise nakliyat sayfasına E10 hücresine Yapraklı Yapacak ve F10 hücresine j21 hücresindeki m3 aktaracak. G18 hücresindeki tarihi ise D10 hücresine yazacak. K21 hücresinde Ster dolu ise nakliyat sayfasında E11 hücresine Sterli Odun ve G11 hücresine K11 hücresindeki steri aktaracak. G18 hücresindeki tarihi ise D10 hücresine yazacak .Veri Girişi sayfasında G5 hücresinde Tespit No aynı ise aktarılan verinin üzerine yazacak. Tespit no farklı ise bir sonraki satıra aktarım yapılacak. Örnekteki gibi. Destek olursanız sevinirim.
Not: Veri girişinde sadece m3 dolu ise onu aktaracak. Sadece Ster dolu ise sadece steri aktaracak. İkisi dolu ise her ikisini aktaracak.

İndir Örnek xlsx

Dosyayı indir Örnek xlsx

dosya.co

 

[muhasebeciyiz]

Sub VeriAktar_Stabil()
    
    Dim veriSayfa As Worksheet
    Dim nakliyatSayfa As Worksheet
    Dim tespitNo As String
    Dim tarih As Variant
    Dim m3 As Variant
    Dim ster As Variant
    Dim i As Long
    Dim m3_bulundu As Boolean
    Dim ster_bulundu As Boolean
    
    Set veriSayfa = ThisWorkbook.Sheets("Veri Girişi")
    Set nakliyatSayfa = ThisWorkbook.Sheets("Nakliyat")
    
    tespitNo = veriSayfa.Range("G5").Value
    tarih = veriSayfa.Range("G18").Value
    m3 = veriSayfa.Range("J21").Value
    ster = veriSayfa.Range("K21").Value
    
    If IsEmpty(m3) And IsEmpty(ster) Then
        MsgBox "Aktarılacak veri yok (m3 veya ster boş).", vbExclamation
        Exit Sub
    End If
  
    If Not IsEmpty(m3) Then
        m3_bulundu = False
        For i = 10 To nakliyatSayfa.Cells(nakliyatSayfa.Rows.Count, "D").End(xlUp).Row
            If nakliyatSayfa.Cells(i, "D").Value = tarih And _
               nakliyatSayfa.Cells(i, "H").Value = tespitNo And _
               nakliyatSayfa.Cells(i, "E").Value = "Yapraklı" Then
                nakliyatSayfa.Cells(i, "F").Value = m3
                m3_bulundu = True
                Exit For
            End If
        Next i
        
        If Not m3_bulundu Then
            Dim yeniSatir As Long
            yeniSatir = nakliyatSayfa.Cells(nakliyatSayfa.Rows.Count, "D").End(xlUp).Row + 1
            nakliyatSayfa.Cells(yeniSatir, "D").Value = tarih
            nakliyatSayfa.Cells(yeniSatir, "H").Value = tespitNo
            nakliyatSayfa.Cells(yeniSatir, "E").Value = "Yapraklı"
            nakliyatSayfa.Cells(yeniSatir, "F").Value = m3
        End If
    End If
    
    If Not IsEmpty(ster) Then
        ster_bulundu = False
        For i = 10 To nakliyatSayfa.Cells(nakliyatSayfa.Rows.Count, "D").End(xlUp).Row
            If nakliyatSayfa.Cells(i, "D").Value = tarih And _
               nakliyatSayfa.Cells(i, "H").Value = tespitNo And _
               nakliyatSayfa.Cells(i, "E").Value = "Sterli Odun" Then
                nakliyatSayfa.Cells(i, "G").Value = ster
                ster_bulundu = True
                Exit For
            End If
        Next i
      
        If Not ster_bulundu Then
            Dim yeniSatir2 As Long
            yeniSatir2 = nakliyatSayfa.Cells(nakliyatSayfa.Rows.Count, "D").End(xlUp).Row + 1
            nakliyatSayfa.Cells(yeniSatir2, "D").Value = tarih
            nakliyatSayfa.Cells(yeniSatir2, "H").Value = tespitNo
            nakliyatSayfa.Cells(yeniSatir2, "E").Value = "Sterli Odun"
            nakliyatSayfa.Cells(yeniSatir2, "G").Value = ster
        End If
    End If

    MsgBox "Veri başarıyla aktarıldı.", vbInformation

End Sub

Veri girişi sayfasının kod bölümüne kopyalayıp deneyiniz