How to copy data from single cells to merge cells and vice versa

[kamranyd]

i have these codes which copy data from data sheet to quot sheet was working fine, but now my quot sheet has few merge cells now it dont copy. does merge cells dont copy values from single cells sheets?

Sub search_quot()
    Dim Quot_No As String, Fnd As Range, Ws1 As Worksheet, Ws2 As Worksheet, FileNameRef As String, X As Long, Y As Long: Y = 17
    
    Sheets("Quot").Unprotect
    Application.ScreenUpdating = False
    
    Set Ws1 = Sheets("database")
    Set Ws2 = Sheets("QUOT")
    
    FileNameRef = Range("I3").Value
    
    Set Fnd = Ws1.Range("A:A").Find(Ws2.Range("I3").Value, , , xlWhole, , , , , False)
    If Fnd Is Nothing Then MsgBox "Quotation Number [-]> " & FileNameRef & " <[-]" & vbNewLine & "Not found in Quotation Database.", vbExclamation, "Quote Search ERROR": Exit Sub
    
    With Ws2
        .Range("I4").Value = Fnd.Offset(, 1).Value
        .Range("I5").Value = Fnd.Offset(, 128).Value
        .Range("C8").Value = Fnd.Offset(, 2).Value
        .Range("C9").Value = Fnd.Offset(, 3).Value
        .Range("A49").Value = Fnd.Offset(, 129).Value
        .Range("A51").Value = Fnd.Offset(, 130).Value
        .Range("H61").Value = Fnd.Offset(, 7).Value
             For X = 8 To 124 Step 4
            .Range("A" & Y).Resize(, 4).Value = Array(Fnd.Offset(, X).Value, Fnd.Offset(, X + 1).Value, Fnd.Offset(, X + 2).Value, Fnd.Offset(, X + 3).Value)
            Y = Y + 1
        Next X
    End With
     Range("A17").Select
     ActiveWindow.ScrollRow = 1
    'Sheets("Quot").Protect AllowFormattingCells:=True
    Application.ScreenUpdating = True
End Sub

 

[Alex Blakenburg]

It doesn't look like you gave access to anyone with the link. It is asking me to sign in.

 

[kamranyd]

It doesn't look like you gave access to anyone with the link. It is asking me to sign in.

oh ok sorry uploaded in google drive now you can download

Oilfield.new - Copy.xlsm

drive.google.com

 

[Alex Blakenburg]

Using the code that is in the Oilfield workbook, can you try
replacing this:

        For X = 8 To 124 Step 4
            For Each cell In .range("A" & Y & ":D" & Y).Cells
                cell.Value = Fnd.Offset(, X).Value
                If cell.MergeCells Then
                    ' Handle merged cells
                    cell.MergeCells = False
                    cell.MergeArea.Value = Fnd.Offset(, X).Value
                    cell.MergeCells = True
                End If
                X = X + 1
            Next cell
            Y = Y + 1
        Next X

With this

        For X = 8 To 124 Step 4
            .Range("A" & Y).Value = Fnd.Offset(, X).Value
            .Range("B" & Y).Value = Fnd.Offset(, X + 1).Value
            .Range("G" & Y).Value = Fnd.Offset(, X + 2).Value
            .Range("H" & Y).Value = Fnd.Offset(, X + 3).Value
            Y = Y + 1
        Next X

 

[kamranyd]

Using the code that is in the Oilfield workbook, can you try
replacing this:

        For X = 8 To 124 Step 4
            For Each cell In .range("A" & Y & ":D" & Y).Cells
                cell.Value = Fnd.Offset(, X).Value
                If cell.MergeCells Then
                    ' Handle merged cells
                    cell.MergeCells = False
                    cell.MergeArea.Value = Fnd.Offset(, X).Value
                    cell.MergeCells = True
                End If
                X = X + 1
            Next cell
            Y = Y + 1
        Next X

With this

        For X = 8 To 124 Step 4
            .Range("A" & Y).Value = Fnd.Offset(, X).Value
            .Range("B" & Y).Value = Fnd.Offset(, X + 1).Value
            .Range("G" & Y).Value = Fnd.Offset(, X + 2).Value
            .Range("H" & Y).Value = Fnd.Offset(, X + 3).Value
            Y = Y + 1
        Next X

thank you very much these code work, now qty and unit price get copy from database sheet back to quot sheet. if you downloaded my sample file, you can see if i save quot sheet data in database sheet it dont save qty and unit price in database, if you can do something about it. these are the codes

i = 8
      For r = 1 To 30
         For j = 1 To 4
         C = Choose(j, 1, 2, 3, 4)
         Debug.Print .range("A17:A46,B17:F46,G17:G46,H20:H46").Cells(r, C).Address
            Rng.Offset(1, i).Value = .range("A17:A46,B17:F46,G17:G46,H20:H46").Cells(r, C)
            i = i + 1
         Next j
      Next r

 

[Alex Blakenburg]

I am login off for tonight and will have a look tomorrow.
Can you confirm which sub we are talking about now ? Is it qaddata ? and is it meant to write from quote to the database ?

 

[kamranyd]

I am login off for tonight and will have a look tomorrow.
Can you confirm which sub we are talking about now ? Is it qaddata ? and is it meant to write from quote to the database ?

ok thnx again
yes correct q_add_data which is meant to save data to database

 

[Alex Blakenburg]

Try changing your Choose line to the one below:

         C = Choose(j, 1, 2, 7, 8)                  ' Data columns are A, B, G, H

 

[kamranyd]

Try changing your Choose line to the one below:

         C = Choose(j, 1, 2, 7, 8)                  ' Data columns are A, B, G, H

thank you very much, really

 

[Alex Blakenburg]

You're welcome. Glad I could help.

 

[kamranyd]

You're welcome. Glad I could help.

i applied all codes, but it seems sheet is slow to save data, is there any way to make it fast, or any other way codes execute quick?