transfer data from sheet1 to sheet2 vertically based on value of cell

[abdelfattah]

hello
i have sheet1 contains data i would transfer data to sheet2 vertically if value of cell e3 in sheet2 = the brand colored by green in sheet1
before

after

 

[mumps]

You could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

 

[abdelfattah]

this is my file i hope this help
merge ‬.xls

 

[abdelfattah]

thanks dante but the problem is continued as i said in post5#

 

[DanteAmor]

thanks dante but the problem is continued as i said in post5#

This is really how your data is, in the first data there are 2 rows of space; in the second data there are no rows?

 

[abdelfattah]

actually dante i don't understand what you mean to know how is the result 1400r20 in sheet2 it begins from a5 :k10 but vertically and when i write 1200r20 it supposes clear data 1400r20 and copy from a13:k18 and check my file

 

[DanteAmor]

actually dante i don't understand what you mean to know how is the result 1400r20 in sheet2 it begins from a5 :k10 but vertically and when i write 1200r20 it supposes clear data 1400r20 and copy from a13:k18 and check my file

What macros do is assume that the data has a pattern on sheet1
What macros do is look for the data in column F on sheet1 and from there consider 2 rows down to take the data.

But your data does not have an organization in only 2 examples.
That's what I mean.

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, fnd As Range, DateRow As Long, cnt As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    desWS.UsedRange.Offset(3).ClearContents
    Set fnd = Range("F:F").Find(desWS.Range("E3"), LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        DateRow = Range("A" & fnd.Row + 1 & ":A" & LastRow).Find("DATE").Row
        With Range("A" & fnd.Row + 2 & ":A" & LastRow).SpecialCells(xlCellTypeConstants)
            cnt = .Areas.Item(1).Cells.Count
            srcWS.Range("A5:E5").Copy desWS.Range("A5")
            srcWS.Cells(DateRow + 1, 1).Resize(cnt - 1, 5).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
            srcWS.Cells(DateRow + 1, 7).Resize(cnt - 1, 5).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    End If
    Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

The following macro considers the 3 cases presented by you so far on sheet1.
The data is 1 row, 2 rows or 3 rows down.
If your data is not organized as you present it in your examples, then the macro will not work either.

Sub transfer_data()
  Dim f As Range, a As Range, sh1 As Worksheet, ini As Variant
  Set sh1 = Sheets("Sheet1")
  With Sheets("Sheet2")
    .Range("A5:E" & Rows.Count).ClearContents
    Set f = sh1.Range("F:F").Find(.Range("E3"), , xlValues, xlWhole)
    If Not f Is Nothing Then
      Set a = sh1.Range("A" & f.Offset(, -1).End(4).Row & ":K" & sh1.Range("A" & f.Row + 3).End(4).Row)
      .Range("A5").Resize(a.Rows.Count, 5).Value = a.Value
      .Range("A" & Rows.Count).End(3)(2).Resize(a.Rows.Count - 1, 5).Value = a.Offset(1, 6).Value
    End If
  End With
End Sub

 

[abdelfattah]

hi,
mumps

not completely now the is a problem about 1200r20 itdoes not copy row 18 from sheet1 i'm sorry said that

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, fnd As Range, DateRow As Long, cnt As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    desWS.UsedRange.Offset(3).ClearContents
    Set fnd = Range("F:F").Find(desWS.Range("E3"), LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        DateRow = Range("A" & fnd.Row + 1 & ":A" & LastRow).Find("DATE").Row
        With Range("A" & fnd.Row + 2 & ":A" & LastRow).SpecialCells(xlCellTypeConstants)
            cnt = .Areas.Item(1).Cells.Count
            srcWS.Range("A5:E5").Copy desWS.Range("A5")
            srcWS.Cells(DateRow + 1, 1).Resize(cnt, 5).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
            srcWS.Cells(DateRow + 1, 7).Resize(cnt, 5).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    End If
    Application.ScreenUpdating = True
End Sub