Advertisement
YasserKhalil2019

T4050_Transfer Data From UserForm To Worksheet

Oct 6th, 2019
283
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.49 KB | None | 0 0
  1. https://excel-egy.com/forum/t4050
  2. ---------------------------------
  3.  
  4. Private Sub CommandButton1_Click()
  5. Dim ws As Worksheet, lr As Long, i As Long, j As Long
  6.  
  7. On Error Resume Next
  8. Me.TextBox7 = Me.TextBox5 * Me.TextBox6
  9. Me.TextBox10 = Me.TextBox8 * Me.TextBox9
  10. Me.TextBox13 = Me.TextBox11 * Me.TextBox12
  11. Me.TextBox16 = Me.TextBox14 * Me.TextBox15
  12. TextBox17.Value = Val(Val(TextBox7.Value) + Val(TextBox10.Value) + Val(TextBox13.Value) + Val(TextBox16.Value))
  13.  
  14. Application.ScreenUpdating = False
  15. Set ws = ThisWorkbook.Worksheets(1)
  16.  
  17. With ws
  18. lr = .Cells(13, 1).End(xlUp).Row + 1
  19.  
  20. For i = 1 To 4
  21. If Me.Controls("TextBox" & i).Value <> "" Then
  22. .Cells(lr, 1).Value = Me.Controls("TextBox" & i).Value
  23.  
  24. For j = 1 To 3
  25. .Cells(lr, j + 1).Value = Me.Controls("ComboBox" & i + 4 * j - 4).Value
  26. Next j
  27.  
  28. For j = 1 To 3
  29. .Cells(lr, j + 4).Value = Me.Controls("TextBox" & 3 * i + j + 1).Value
  30. Next j
  31.  
  32. lr = lr + 1
  33. If lr = 13 Then MsgBox "No More Rows", vbExclamation: Exit Sub
  34. End If
  35. Next i
  36. End With
  37. Application.CutCopyMode = False
  38. Application.ScreenUpdating = True
  39.  
  40. MsgBox "Done...", 64
  41. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement