Data extraction based on condition

K

kamranyd

Board Regular
Joined
Apr 24, 2018
Messages
152
Office Version
  1. 2021
Platform
  1. Windows
Code: 
Sub transfer()
Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim myname As String
lastrow1 = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row


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


For i = 2 To lastrow1
myname = Sheets("sheet1").Cells(i, "A").Value


Sheets("sheet2").Activate
lastrow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row


For j = 2 To lastrow2


If Sheets("sheet2").Cells(j, "A").Value = myname Then
Sheets("sheet1").Activate
Sheets("sheet1").Range(Cells(i, "B"), Cells(i, "G")).Copy
Sheets("sheet2").Activate
Sheets("sheet2").Range(Cells(j, "B"), Cells(j, "C")).Select
ActiveSheet.Paste
End If


Next j
Application.CutCopyMode = False
Next i
Sheets("sheet2").Activate
Sheets("sheet2").Range("A1").Select
End Sub


can somebody help with these codes which extract data as per given names. i want help to copy values from anywhere from cells of data sheet and copy in another sheet any given cell. which part of codes i shall change. Thanks
 
Sort by date Sort by votes
Code: 
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

Thank you so much Sir Fluff.... if you dont mind will you help me in codes i m using but its very long.. i want to make it short so it can execute quick.
 
Upvote 0

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
As this is a completely different question, please start a new thread.
 
Upvote 0
thnks for the code but these copy format also i need to copy values only.
 
Upvote 0
How about
Code: 
Sub CopyFilter()
   Dim Cl As Range
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   Dim Flg As Boolean
   
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("sheet2")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Cl
      Next Cl
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then
            Flg = True
            Ws2.Range("2:1048576").ClearContents
            .Item(Cl.Value).Resize(, 4).Value = Cl.Resize(, 4).Value
            .Item(Cl.Value).Offset(, 5).Value = Cl.Offset(, 4).Value
            .Item(Cl.Value).Offset(, 7).Value = Cl.Offset(, 5).Value
            .Item(Cl.Value).Offset(, 9).Value = Cl.Offset(, 6).Value
         End If
      Next Cl
   End With
   If Flg = False Then MsgBox "Nothing Found"
End Sub
 
Upvote 0
Fluff said:
Ok, try this
Code: 
Sub CopyFilter()
   Dim Cl As Range
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("Sheet2")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 1)
      Next Cl
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then
            Cl.Offset(, 1).Resize(, 3).Copy .Item(Cl.Value)
            Cl.Offset(, 4).Copy .Item(Cl.Value).Offset(, 4)
            Cl.Offset(, 5).Copy .Item(Cl.Value).Offset(, 6)
            Cl.Offset(, 6).Copy .Item(Cl.Value).Offset(, 8)
         End If
      Next Cl
   End With
End Sub
Click to expand...
thnx now values getting copying....but merged cells dont get copy...is there something you an do...
 
Upvote 0
.Item(Cl.Value).Offset(10, 3).Value = Cl.Offset(, 6).Value 'Description

these cells values should be copy on another sheet who has merged cells from "BCDEFGH"
other cells get copy from sheet1 to sheet2 but single cells doesnt get copy on merged cells
 
Upvote 0
Assuming that this the search Quot function from you other thread try
Code: 
Sub Search_Quot()
   Dim Fnd As Range
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   Dim Ary As Variant
   Dim i As Long, j As Long
   
   Application.ScreenUpdating = False
   
   Set Ws1 = Sheets("database")
   Set Ws2 = Sheets("QUOT")
   Set Fnd = Ws1.Range("A:A").Find(Ws2.Range("B10").Value, , , xlWhole, , , , , False)
   If Fnd Is Nothing Then MsgBox "Quotation number not found", vbInformation, "Quote Search": Exit Sub
   Ws2.Range("B13").Value = Fnd.Offset(, 2).Value
   Ws2.Range("J13").Value = Fnd.Offset(, 1).Value
   Ws2.Range("C15").Value = Fnd.Offset(, 3).Value
   Ws2.Range("J65").Value = Fnd.Offset(, 5).Value
   Ary = Ws1.Range(Fnd.Offset(, 6), Ws1.Cells(Fnd.Row, Columns.Count).End(xlToLeft))
   j = 20
   For i = 1 To UBound(Ary, 2) Step 3
      Ws2.Range("b" & j).Value = Ary(1, i)
      Ws2.Range("H" & j).Value = Ary(1, i + 1)
      Ws2.Range("I" & j).Value = Ary(1, i + 2)
      j = j + 1
   Next i
      
End Sub
 
Upvote 0
Code: 
Sub Search_Quot()
   Dim Fnd As Range
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   Dim Ary As Variant
   Dim i As Long, j As Long
   
   
   Application.ScreenUpdating = False
   
   Set Ws1 = Sheets("database")
   Set Ws2 = Sheets("QUOT")
   Set Fnd = Ws1.Range("A:A").Find(Ws2.Range("B10").Value, , , xlWhole, , , , , False)
   If Fnd Is Nothing Then MsgBox "Quotation number not found", vbInformation, "Quote Search": Exit Sub
   
   Ws2.Range("A20:I55").ClearContents
   
   Ws2.Range("B13").Value = Fnd.Offset(, 2).Value
   Ws2.Range("J13").Value = Fnd.Offset(, 1).Value
   Ws2.Range("C15").Value = Fnd.Offset(, 3).Value
   Ws2.Range("H65").Value = Fnd.Offset(, 5).Value
   Ary = Ws1.Range(Fnd.Offset(, 6), Ws1.Cells(Fnd.Row, Columns.Count).End(xlToLeft))
   j = 20
   For i = 1 To UBound(Ary, 2) Step 4
      Ws2.Range("A" & j).Value = Ary(1, i)
      Ws2.Range("B" & j).Value = Ary(1, i + 1)
      Ws2.Range("H" & j).Value = Ary(1, i + 2)
      Ws2.Range("I" & j).Value = Ary(1, i + 3)
      j = j + 1
   Next i
      
End Sub

below codes copy correct with no error
Ws2.Range("A" & j).Value = Ary(1, i)
Ws2.Range("B" & j).Value = Ary(1, i + 1)

but these below codes copy correct with error that is .....runtime error 9 "subscript out of range"
Ws2.Range("H" & j).Value = Ary(1, i + 2)
Ws2.Range("I" & j).Value = Ary(1, i + 3)
 
Upvote 0
I suspect that some of the data in the datatbase doesn't have values for each col
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
Code to search job id from multiple sources and update main spreadsheet.
2
Replies
10
Views
642
mumps
mumps
N
  • Question Question
Finding the differences then copy and paste code to a new sheet
Replies
1
Views
624
myall_blues
myall_blues
P
  • Question Question
Code used for comparison between 2 list.
Replies
3
Views
645
Tupe77
T
C
  • Question Question
Combining rows 3 through 7 into row 2, one row takes a painfully long time with this code. Why?
Replies
2
Views
247
jolivanes
jolivanes
G
  • Solved
Typing out Excel formula in Excel Macro
Replies
1
Views
48
Macropod
Macropod

Forum statistics

Threads
1,223,911
Messages
6,175,333
Members
452,636
Latest member
laura12345

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