كود نقل بيانات

[alaa111]

السلام عليكم

الرجاء المساعده فى كود نقل البيانات

عندما يتم تغيير الحاله داخل الفورم من (check in) الى (check out) يتم نقل البيانات من شيت داتا بيز من (A :R) الى شيت (check out)

وحذف البيانات بعد النقل

وشكرا جزيلا

program.xlsm

[أ / محمد صالح]

تفضل هذا ملفك بعد تعديل إجراء التسليم إلى ما يلي

Sub Submit_Data()
    Dim iRow As Long, row As Long, sh As Worksheet
    If frmDataEntry.txtRowNumber.Value = "" Then
    Set sh = shDatabase
    iRow = sh.Range("A" & Rows.Count).End(xlUp).row + 1
    Else
    If frmDataEntry.ComboBox7 = "Check OUT" Then
    Set sh = Sheet2
    iRow = sh.Range("A" & Rows.Count).End(xlUp).row + 1
    row = frmDataEntry.lstDatabase.List(frmDataEntry.lstDatabase.ListIndex, 0) + 1
    ThisWorkbook.Sheets("Database").Rows(row).Delete
    Else
    Set sh = shDatabase
    iRow = frmDataEntry.txtRowNumber.Value
    End If
    End If
    With sh.Range("A" & iRow)
        .Offset(0, 0).Value = "=if(b" & iRow & "="""","""",Row()-1)"
        .Offset(0, 1).Value = frmDataEntry.TextBox1.Value
        .Offset(0, 2).Value = frmDataEntry.TextBox2.Value
        .Offset(0, 3).Value = frmDataEntry.TextBox3.Value
        .Offset(0, 4).Value = frmDataEntry.ComboBox1.Value
        .Offset(0, 5).Value = frmDataEntry.ComboBox2.Value
        .Offset(0, 6).Value = frmDataEntry.TextBox4.Value
        .Offset(0, 7).Value = frmDataEntry.TextBox5.Value
        .Offset(0, 8).Value = frmDataEntry.TextBox6.Value
        .Offset(0, 9).Value = frmDataEntry.TextBox7.Value
        .Offset(0, 10).Value = frmDataEntry.TextBox8.Value
        .Offset(0, 11).Value = frmDataEntry.ComboBox3.Value
        .Offset(0, 12).Value = frmDataEntry.ComboBox4.Value
        .Offset(0, 13).Value = frmDataEntry.ComboBox5.Value
        .Offset(0, 14).Value = frmDataEntry.ComboBox6.Value
        .Offset(0, 15).Value = frmDataEntry.TextBox9.Value
        .Offset(0, 16).Value = frmDataEntry.ComboBox7.Value
    End With
    If frmDataEntry.txtRowNumber.Value = "" Then
        MsgBox "Data Submitted Successfully!"
    Else
        MsgBox "Data updated Successfully!"
    End If
    Call Reset_Form
    Application.ScreenUpdating = True
End Sub

بالتوفيق

program.xlsm