Copy and Paste range into separate worksheet

[Schaefer156]

Hello,
I am looking to figure out this VBA code I am trying to write for a project I am working on, I have it that it will search for a certain text in column L, once it finds that certain word I want it to copy and paste columns A-K down from the row that it found the certain word until a blank cell and only copy those row, for example, I have the code search for K3 and when it finds it it will copy rows 6-11 to the next worksheet. And I know I can do it by setting the range but if someone comes in and adds a row it will mess up the range.

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, fnd As Range
    Set fnd = Range("L:L").Find("K3", LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        LastRow = Range("L" & fnd.Row, Range("L" & Rows.Count).End(xlUp)).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlNext).Row - 1
        Rows(fnd.Row & ":" & LastRow).Copy Sheets("Paste").Range("A6")
    End If
    Application.ScreenUpdating = True
End Sub

 

[Schaefer156]

That worked great! Is there a way I can make it only copy until column K or will it always copy the entire rows? And if I want to repeat those steps by searching for K3.1 and so on would it would still work correct?

 

[mumps]

if I want to repeat those steps by searching for K3.1

Do you want the values for K3.1 to be added to the existing data or to replace the existing data? Also, do you always want to start the pasting at A6.

 

[Schaefer156]

To be added underneath existing data.

 

[mumps]

do you always want to start the pasting at A6.

 

[Schaefer156]

Correct, I would like the first Paste to start at A6 and then each new section to be pasted 1 empty space underneath already pasted text.

 

[Schaefer156]

Pretty much the exact same way as in the first photo but it wouldn't be for every section i have in my sheet, only the one marked for the K3.1 and so on.

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, fnd As Range
    Set fnd = Range("L:L").Find("K3", LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        LastRow = Range("L" & fnd.Row, Range("L" & Rows.Count).End(xlUp)).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlNext).Row - 1
        With Sheets("Sheet2")
            If .Range("A6") = "" Then
                Range("A" & fnd.Row & ":K" & LastRow).Copy .Range("A6")
            Else
                Range("A" & fnd.Row & ":K" & LastRow).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
            End If
        End With
    End If
    Application.ScreenUpdating = True
End Sub

 

[Schaefer156]

YES! Thankyou that worked perfect!!