Data transfer

K

kamranyd

Board Regular
Joined
Apr 24, 2018
Messages
152
Office Version
  1. 2021
Platform
  1. Windows
Code: 
[COLOR=#333333]Option Explicit
Sub addata()


ActiveSheet.Unprotect


Dim Quot_No As String
Dim Attn_Name As String
Dim Co_Name As String
Dim Quot_Date As String
Dim Total_Price As String
Dim Auth_Name As String


Dim Des_CellB20 As String
Dim Des_CellH20 As String
Dim Des_CellI20 As String
Dim Des_CellB21 As String
Dim Des_CellH21 As String
Dim Des_CellI21 As String
Dim Des_CellB22 As String
Dim Des_CellH22 As String
Dim Des_CellI22 As String
Dim Des_CellB23 As String
Dim Des_CellH23 As String
Dim Des_CellI23 As String
Dim Des_CellB24 As String
Dim Des_CellH24 As String
Dim Des_CellI24 As String
Dim Des_CellB25 As String
Dim Des_CellH25 As String
Dim Des_CellI25 As String
Dim Des_CellB26 As String
Dim Des_CellH26 As String
Dim Des_CellI26 As String
Dim Des_CellB27 As String
Dim Des_CellH27 As String
Dim Des_CellI27 As String
Dim Des_CellB28 As String
Dim Des_CellH28 As String
Dim Des_CellI28 As String
Dim Des_CellB29 As String
Dim Des_CellH29 As String
Dim Des_CellI29 As String
Dim Des_CellB30 As String
Dim Des_CellH30 As String
Dim Des_CellI30 As String
Dim Des_CellB31 As String
Dim Des_CellH31 As String
Dim Des_CellI31 As String
Dim Des_CellB32 As String
Dim Des_CellH32 As String
Dim Des_CellI32 As String
Dim Des_CellB33 As String
Dim Des_CellH33 As String
Dim Des_CellI33 As String
Dim Des_CellB34 As String
Dim Des_CellH34 As String
Dim Des_CellI34 As String
Dim Des_CellB35 As String
Dim Des_CellH35 As String
Dim Des_CellI35 As String
Dim Des_CellB36 As String
Dim Des_CellH36 As String
Dim Des_CellI36 As String
Dim Des_CellB37 As String
Dim Des_CellH37 As String
Dim Des_CellI37 As String
Dim Des_CellB38 As String
Dim Des_CellH38 As String
Dim Des_CellI38 As String
Dim Des_CellB39 As String
Dim Des_CellH39 As String
Dim Des_CellI39 As String
Dim Des_CellB40 As String
Dim Des_CellH40 As String
Dim Des_CellI40 As String
Dim Des_CellB41 As String
Dim Des_CellH41 As String
Dim Des_CellI41 As String
Dim Des_CellB42 As String
Dim Des_CellH42 As String
Dim Des_CellI42 As String
Dim Des_CellB43 As String
Dim Des_CellH43 As String
Dim Des_CellI43 As String
Dim Des_CellB44 As String
Dim Des_CellH44 As String
Dim Des_CellI44 As String
Dim Des_CellB45 As String
Dim Des_CellH45 As String
Dim Des_CellI45 As String
Dim Des_CellB46 As String
Dim Des_CellH46 As String
Dim Des_CellI46 As String
Dim Des_CellB47 As String
Dim Des_CellH47 As String
Dim Des_CellI47 As String
Dim Des_CellB48 As String
Dim Des_CellH48 As String
Dim Des_CellI48 As String
Dim Des_CellB49 As String
Dim Des_CellH49 As String
Dim Des_CellI49 As String
Dim Des_CellB50 As String
Dim Des_CellH50 As String
Dim Des_CellI50 As String
Dim Des_CellB51 As String
Dim Des_CellH51 As String
Dim Des_CellI51 As String
Dim Des_CellB52 As String
Dim Des_CellH52 As String
Dim Des_CellI52 As String
Dim Des_CellB53 As String
Dim Des_CellH53 As String
Dim Des_CellI53 As String
Dim Des_CellB54 As String
Dim Des_CellH54 As String
Dim Des_CellI54 As String
Dim Des_CellB55 As String
Dim Des_CellH55 As String
Dim Des_CellI55 As String


Worksheets("QUOT").Select
Application.ScreenUpdating = False


Quot_No = Range("B10")
If Len(Worksheets("QUOT").Range("B10").Value) = 0 Then
    MsgBox "Please enter quotation number", vbInformation, "Quotation Number Error"
    Application.Goto Worksheets("QUOT").Range("B10")
    Exit Sub
    End If


Attn_Name = Range("B13")
If Len(Worksheets("QUOT").Range("B13").Value) = 0 Then
    MsgBox "Please enter receiver name", vbInformation, "Quotation Receiver Name Error"
    Application.Goto Worksheets("QUOT").Range("B13")
    Exit Sub
    End If
    
Co_Name = Range("C15")
If Len(Worksheets("QUOT").Range("C15").Value) = 0 Then
    MsgBox "Please enter Company / Customer name", vbInformation, "Quotation Company / Customer Name Error"
    Application.Goto Worksheets("QUOT").Range("C15")
    Exit Sub
    End If


Quot_Date = Range("J13")
If Len(Worksheets("QUOT").Range("J13").Value) = 0 Then
    MsgBox "Please enter quotation date", vbInformation, "Quotation Date Error"
    Application.Goto Worksheets("QUOT").Range("J13")
    Exit Sub
    End If


Total_Price = Range("J58")
If Len(Worksheets("QUOT").Range("J58").Value) = 0 Then
    MsgBox "Please enter quotation Price", vbInformation, "Quotation Price Error"
    Application.Goto Worksheets("QUOT").Range("J58")
    Exit Sub
    End If


Auth_Name = Range("H65")
If Len(Worksheets("QUOT").Range("H65").Value) = 0 Then
    MsgBox "Please select authorize person name", vbInformation, "Quotation Authorization Error"
    Application.Goto Worksheets("QUOT").Range("H65")
    Exit Sub
    End If
    
Des_CellB20 = Range("B20")
Des_CellH20 = Range("H20")
Des_CellI20 = Range("I20")
Des_CellB21 = Range("B21")
Des_CellH21 = Range("H21")
Des_CellI21 = Range("I21")
Des_CellB22 = Range("B22")
Des_CellH22 = Range("H22")
Des_CellI22 = Range("I22")
Des_CellB23 = Range("B23")
Des_CellH23 = Range("H23")
Des_CellI23 = Range("I23")
Des_CellB24 = Range("B24")
Des_CellH24 = Range("H24")
Des_CellI24 = Range("I24")
Des_CellB25 = Range("B25")
Des_CellH25 = Range("H25")
Des_CellI25 = Range("I25")
Des_CellB26 = Range("B26")
Des_CellH26 = Range("H26")
Des_CellI26 = Range("I26")
Des_CellB27 = Range("B27")
Des_CellH27 = Range("H27")
Des_CellI27 = Range("I27")
Des_CellB28 = Range("B28")
Des_CellH28 = Range("H28")
Des_CellI28 = Range("I28")
Des_CellB29 = Range("B29")
Des_CellH29 = Range("H29")
Des_CellI29 = Range("I29")
Des_CellB30 = Range("B30")
Des_CellH30 = Range("H30")
Des_CellI30 = Range("I30")
Des_CellB31 = Range("B31")
Des_CellH31 = Range("H31")
Des_CellI31 = Range("I31")
Des_CellB32 = Range("B32")
Des_CellH32 = Range("H32")
Des_CellI32 = Range("I32")
Des_CellB33 = Range("B33")
Des_CellH33 = Range("H33")
Des_CellI33 = Range("I33")
Des_CellB34 = Range("B34")
Des_CellH34 = Range("H34")
Des_CellI34 = Range("I34")
Des_CellB35 = Range("B35")
Des_CellH35 = Range("H35")
Des_CellI35 = Range("I35")
Des_CellB36 = Range("B36")
Des_CellH36 = Range("H36")
Des_CellI36 = Range("I36")
Des_CellB37 = Range("B37")
Des_CellH37 = Range("H37")
Des_CellI37 = Range("I37")
Des_CellB38 = Range("B38")
Des_CellH38 = Range("H38")
Des_CellI38 = Range("I38")
Des_CellB39 = Range("B39")
Des_CellH39 = Range("H39")
Des_CellI39 = Range("I39")
Des_CellB40 = Range("B40")
Des_CellH40 = Range("H40")
Des_CellI40 = Range("I40")
Des_CellB41 = Range("B41")
Des_CellH41 = Range("H41")
Des_CellI41 = Range("I41")
Des_CellB42 = Range("B42")
Des_CellH42 = Range("H42")
Des_CellI42 = Range("I42")
Des_CellB43 = Range("B43")
Des_CellH43 = Range("H43")
Des_CellI43 = Range("I43")
Des_CellB44 = Range("B44")
Des_CellH44 = Range("H44")
Des_CellI44 = Range("I44")
Des_CellB45 = Range("B45")
Des_CellH45 = Range("H45")
Des_CellI45 = Range("I45")
Des_CellB46 = Range("B46")
Des_CellH46 = Range("H46")
Des_CellI46 = Range("I46")
Des_CellB47 = Range("B47")
Des_CellH47 = Range("H47")
Des_CellI47 = Range("I47")
Des_CellB48 = Range("B48")
Des_CellH48 = Range("H48")
Des_CellI48 = Range("I48")
Des_CellB49 = Range("B49")
Des_CellH49 = Range("H49")
Des_CellI49 = Range("I49")
Des_CellB50 = Range("B50")
Des_CellH50 = Range("H50")
Des_CellI50 = Range("I50")
Des_CellB51 = Range("B51")
Des_CellH51 = Range("H51")
Des_CellI51 = Range("I51")
Des_CellB52 = Range("B52")
Des_CellH52 = Range("H52")
Des_CellI52 = Range("I52")
Des_CellB53 = Range("B53")
Des_CellH53 = Range("H53")
Des_CellI53 = Range("I53")
Des_CellB54 = Range("B54")
Des_CellH54 = Range("H54")
Des_CellI54 = Range("I54")
Des_CellB55 = Range("B55")
Des_CellH55 = Range("H55")
Des_CellI55 = Range("I55")


Worksheets("database").Select
Worksheets("database").Range("A2").Select
If Worksheets("database").Range("A2").Offset(1, 0) <> "" Then
Worksheets("database").Range("A2").End(xlDown).Select
End If


ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Quot_No
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Quot_Date
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Attn_Name
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Co_Name
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Total_Price
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Auth_Name


ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB20
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH20
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI20
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB21
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH21
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI21
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB22
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH22
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI22
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB23
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH23
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI23
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB24
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH24
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI24
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB25
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH25
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI25
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB26
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH26
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI26
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB27
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH27
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI27
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB28
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH28
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI28
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB29
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH29
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI29
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB30
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH30
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI30
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB31
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH31
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI31
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB32
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH32
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI32
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB33
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH33
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI33
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB34
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH34
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI34
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB35
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH35
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI36
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB37
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH37
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI37
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB38
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH38
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI38
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB39
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH39
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI39
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB40
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH40
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI40
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB41
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH41
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI41
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB42
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH42
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI42
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB43
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH43
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI43
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB44
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH44
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI44
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB45
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH45
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI45
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB46
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH46
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI46
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB47
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH47
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI47
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB48
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH48
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI48
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB49
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH49
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI49
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB50
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH50
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI50
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB51
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH51
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI51
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB52
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH52
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI52
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB53
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH53
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI53
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB54
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH54
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI54
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellB55
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellH55
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Des_CellI55
ActiveCell.Offset(0, 1).Select


Worksheets("QUOT").Select
Worksheets("QUOT").Range("B10").Select


Range("J13").ClearContents
Range("B13").MergeArea.ClearContents
Range("C15").MergeArea.ClearContents
Range("H65").MergeArea.ClearContents


MsgBox "Quotation Has Been Submitted to Database", vbInformation, "Al-Maliki Mechanical Engineering."
Sheets("QUOT").Range("B10").Value = _
    Sheets("QUOT").Range("B10").Value + 1


ActiveSheet.Protect


End Sub

[/COLOR]
[COLOR=#333333][/COLOR]

i m using these codes for data transfer but its very long.. i want to make it short so it can execute quick.
help will be appreciated.

Thannks
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sort by date Sort by votes
can you paste the workbook somewhere on a safe cloud, i'd like to see what it does, just needs a fake data source page and the output page, I don't think in its self should be too long to operate
 
Upvote 0
How about
Code: 
Option Explicit
Sub addata()
   Dim Quot_No As String
   Dim Attn_Name As String
   Dim Co_Name As String
   Dim Quot_Date As String
   Dim Total_Price As String
   Dim Auth_Name As String
   Dim Rng As Range
   Dim i As Long, r As Long, c As Long
   
   ActiveSheet.Unprotect
   Application.ScreenUpdating = False

   With Worksheets("Quot")
      Quot_No = .Range("B10").Value
      If Len(Quot_No) = 0 Then
         MsgBox "Please enter quotation number", vbInformation, "Quotation Number Error"
         Application.Goto .Range("B10")
         Exit Sub
      End If

      Attn_Name = .Range("B13")
      If Len(Attn_Name) = 0 Then
         MsgBox "Please enter receiver name", vbInformation, "Quotation Receiver Name Error"
         Application.Goto .Range("B13")
         Exit Sub
      End If
    
      Co_Name = .Range("C15")
      If Len(Co_Name) = 0 Then
         MsgBox "Please enter Company / Customer name", vbInformation, "Quotation Company / Customer Name Error"
         Application.Goto .Range("C15")
         Exit Sub
      End If

      Quot_Date = .Range("J13")
      If Len(Quot_Date) = 0 Then
         MsgBox "Please enter quotation date", vbInformation, "Quotation Date Error"
         Application.Goto .Range("J13")
         Exit Sub
      End If

      Total_Price = .Range("J58")
      If Len(Total_Price) = 0 Then
         MsgBox "Please enter quotation Price", vbInformation, "Quotation Price Error"
         Application.Goto .Range("J58")
         Exit Sub
      End If

      Auth_Name = .Range("H65")
      If Len(Auth_Name) = 0 Then
         MsgBox "Please select authorize person name", vbInformation, "Quotation Authorization Error"
         Application.Goto .Range("H65")
         Exit Sub
      End If
      
      Set Rng = Worksheets("sheet2").Range("A2")
      If Rng.Offset(1, 0) <> "" Then Set Rng = Rng.End(xlDown)
      Rng.Offset(1).Resize(, 6).Value = Array(Quot_No, Quot_Date, Attn_Name, Co_Name, Total_Price, Auth_Name)
      i = 6
      For r = 1 To 36
         For c = 1 To 3
            Rng.Offset(1, i).Value = .Range("B20:B55,H20:H55,I20:I55").Cells(r, c)
            i = i + 1
         Next c
      Next r
   End With

   Worksheets("QUOT").Select
   Range("B10").Select
   Range("J13").ClearContents
   Range("B13").MergeArea.ClearContents
   Range("C15").MergeArea.ClearContents
   Range("H65").MergeArea.ClearContents


   MsgBox "Quotation Has Been Submitted to Database", vbInformation, "Al-Maliki Mechanical Engineering."
   Range("B10").Value = Range("B10").Value + 1

   ActiveSheet.Protect
End Sub
 
Upvote 0
Fluff said:
How about
Code: 
Option Explicit
Sub addata()
   Dim Quot_No As String
   Dim Attn_Name As String
   Dim Co_Name As String
   Dim Quot_Date As String
   Dim Total_Price As String
   Dim Auth_Name As String
   Dim Rng As Range
   Dim i As Long, r As Long, c As Long
   
   ActiveSheet.Unprotect
   Application.ScreenUpdating = False

   With Worksheets("Quot")
      Quot_No = .Range("B10").Value
      If Len(Quot_No) = 0 Then
         MsgBox "Please enter quotation number", vbInformation, "Quotation Number Error"
         Application.Goto .Range("B10")
         Exit Sub
      End If

      Attn_Name = .Range("B13")
      If Len(Attn_Name) = 0 Then
         MsgBox "Please enter receiver name", vbInformation, "Quotation Receiver Name Error"
         Application.Goto .Range("B13")
         Exit Sub
      End If
    
      Co_Name = .Range("C15")
      If Len(Co_Name) = 0 Then
         MsgBox "Please enter Company / Customer name", vbInformation, "Quotation Company / Customer Name Error"
         Application.Goto .Range("C15")
         Exit Sub
      End If

      Quot_Date = .Range("J13")
      If Len(Quot_Date) = 0 Then
         MsgBox "Please enter quotation date", vbInformation, "Quotation Date Error"
         Application.Goto .Range("J13")
         Exit Sub
      End If

      Total_Price = .Range("J58")
      If Len(Total_Price) = 0 Then
         MsgBox "Please enter quotation Price", vbInformation, "Quotation Price Error"
         Application.Goto .Range("J58")
         Exit Sub
      End If

      Auth_Name = .Range("H65")
      If Len(Auth_Name) = 0 Then
         MsgBox "Please select authorize person name", vbInformation, "Quotation Authorization Error"
         Application.Goto .Range("H65")
         Exit Sub
      End If
      
      Set Rng = Worksheets("sheet2").Range("A2")
      If Rng.Offset(1, 0) <> "" Then Set Rng = Rng.End(xlDown)
      Rng.Offset(1).Resize(, 6).Value = Array(Quot_No, Quot_Date, Attn_Name, Co_Name, Total_Price, Auth_Name)
      i = 6
      For r = 1 To 36
         For c = 1 To 3
            Rng.Offset(1, i).Value = .Range("B20:B55,H20:H55,I20:I55").Cells(r, c)
            i = i + 1
         Next c
      Next r
   End With

   Worksheets("QUOT").Select
   Range("B10").Select
   Range("J13").ClearContents
   Range("B13").MergeArea.ClearContents
   Range("C15").MergeArea.ClearContents
   Range("H65").MergeArea.ClearContents


   MsgBox "Quotation Has Been Submitted to Database", vbInformation, "Al-Maliki Mechanical Engineering."
   Range("B10").Value = Range("B10").Value + 1

   ActiveSheet.Protect
End Sub
Click to expand...


Thank once again you did what i need really thanks these excute quick than my previous codes...really Thanks alot
 
Upvote 0
Glad we could help & thanks for the feedback
 
Upvote 0
i tested the codes you provided there are 2 problems.
1st B20:B55, get copy but H20:H55,I20:I55 are not getting copy in database.
2nd is database which is getting copy are on protected sheet and i want data should copy and the sheet2 remain protected, is it possible
thnks
 
Last edited:
Upvote 0
If you add this to the end of the code sheet2 will get protected
Code: 
   Sheets("sheet2").Protect
Are any of the cells being copied merged cells?
 
Upvote 0
b20:b55 are merged cells but get copied
H20:H55,I20:I55 are not merged cells and in database these cells are empty

if i separate b20:b55 which are merged cells than they dont copy

i can only see b20:b55 cells value but H20:H55,I20:I55 cells r blank
 
Last edited:
Upvote 0
If they are blank then there is nothing to copy
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Tab Selection from Userform based on Date range
Replies
5
Views
134
campbell1093
C
I
  • Question Question
Advice for slight alteration to existing working code
Replies
1
Views
219
ipbr21054
I
W
  • Question Question
Entire Column Format base on Format via Vlookup
Replies
2
Views
337
wiscokid
W
U
  • Question Question
Text Value from Textbox to Integer
Replies
1
Views
333
Kaper
Kaper
G
  • Question Question
Converting and copying specific data
Replies
1
Views
269
GerrardSVK
G

Forum statistics

Threads
1,223,898
Messages
6,175,274
Members
452,628
Latest member
dd2

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top