How to copy all rows above a specific text

[KlaasE]

Hello there,

I am trying to write a macro to copy all general info from an order. This is always row 1 to x, where x is the row where the text "Type" is placed. So this row varies per order. Now I was wondering if it is possible to write a macro where it copies all rows up until the row where "Type" is found (including that row).

Thanks!

 

[alansidman]

In what column is "Type" found?

 

[My Aswer Is This]

Where on the row will we find the term "Type"

Will it be found in column A or B or what column?

And copy the rows and paste them where?

 

[KlaasE]

The term "Type" will be found somewhere between column A and F, this varies as well. I want to paste them to a different worksheet named "InitialSample", on row 20.

Cheers!

 

[alansidman]

Option Explicit

Sub FindType()
    Dim c As Long, rng As Long
    Dim lr As Long, crow As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    Set rng = Range("A1:F" & lr)
    For Each c In rng
        If c = "Type" Then
            crow = c.Row
            Range("A1:F" & crow).Copy
            Sheets("InitialSample").Range("A1").PasteSpecial xlPasteValues
        End If
    Next c
    Exit Sub
End Sub

 

[Rick Rothstein]

If the word "Type" is in a cell by itself, then I think this macro should do what you want...

Sub CopyRowOneDownToRowWithTypeInIt()
  Range("1:" & [A:F].Find("Type", , xlValues, xlWhole, , xlNext, False, , False).Row).Copy Sheets("InitialSample").Range("A20")
End Sub

 

[alansidman]

Just noticed an error in my code. Here is the correction

Sub FindType()
    Dim c As Long, rng As Long
    Dim lr As Long, crow As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    Set rng = Range("A1:F" & lr)
    For Each c In rng
        If c = "Type" Then
            crow = c.Row
            Range("A1:F" & crow).Copy
            Sheets("InitialSample").Range("A20").PasteSpecial xlPasteValues
        End If
    Next c
    Exit Sub
End Sub