Data extraction based on condition

[kamranyd]

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

 

[kamranyd]

yes before i was copying 3 columns from database now i added 1 more column.

before 1st column was description 2nd quantity and 3rd unit price
now i added one more column in database now it is
1st column is serial no. 2nd description 3rd quantity and 4th unit price.

 

[kamranyd]

yes before i was copying 3 columns from database now i added 1 more column.

before 1st column was description 2nd quantity and 3rd unit price
now i added one more column in database now it is
1st column is serial no. 2nd description 3rd quantity and 4th unit price.

after work around in codes. now i know "Ubound" is making problem bcause if i write serial no. & description & qty & unit price than there is no error and data get copy.
but if i write serial no. and leave description cell empty or i write serial no. and description and leave qty cell empty than error show up.

i want these cells should not bound with each other.

 

[Fluff]

Ok, try this

   Ws2.Range("J65").Value = Fnd.Offset(, 5).Value
   j = 20
   For i = 1 To Ws1.Cells(Fnd.Row, Columns.Count).End(xlToLeft).Column Step 4
      Ws2.Range("a" & j).Value = Ws1.Cells(Fnd.Row, i + 6)
      Ws2.Range("b" & j).Value = Ws1.Cells(Fnd.Row, i + 7)
      Ws2.Range("H" & j).Value = Ws1.Cells(Fnd.Row, i + 8)
      Ws2.Range("I" & j).Value = Ws1.Cells(Fnd.Row, i + 9)
      j = j + 1
   Next i

 

[kamranyd]

Ok, try this

   Ws2.Range("J65").Value = Fnd.Offset(, 5).Value
   j = 20
   For i = 1 To Ws1.Cells(Fnd.Row, Columns.Count).End(xlToLeft).Column Step 4
      Ws2.Range("a" & j).Value = Ws1.Cells(Fnd.Row, i + 6)
      Ws2.Range("b" & j).Value = Ws1.Cells(Fnd.Row, i + 7)
      Ws2.Range("H" & j).Value = Ws1.Cells(Fnd.Row, i + 8)
      Ws2.Range("I" & j).Value = Ws1.Cells(Fnd.Row, i + 9)
      j = j + 1
   Next i

Thnx now no error and data get copy also....really your r awesome in VBA.

 

[Fluff]

Glad to help & thanks for the feedback