Selective copying based on cell values

Hi,
This thread has emerged from my previous unsuccessful thread. I have changed my approach. Hope this time it will work.

In sheet1, I am trying to copy Certain cells or rows based on cell value in column K ( K 200 :K 305) if the value is equal to 1.... The respective rows or cells to be copied are from M200: S305.
These are to be pasted to same sheet at columns A to G in the next free row available.

I have tried various things and they don't work....
The code that I would use is as follows:

Sub_CopyOnlyOne()

    Dim sourceRng As Range
    Dim cell As Range
    Dim i As Long

    Set sourceRng = ActiveSheet.Range("K200:K305")
    i = 1

    For Each cell In sourceRng
        If cell.Value = 1 Then
            cell.Resize(1, 5).Copy Destination:=Range("A76:G190" & i)
            'this is a problem area
            i = i + 1
        End If
    Next cell

End Sub

I have attached the book as well....
Many thanks

Regards

Maybe:

Sub KK1234()
Dim i As Long
For i = 200 To 305
    If Range("K" & i).Value = 1 Then
        Range(Range("K" & i).Offset(, 2), Range("K" & i).Offset(, 8)).Copy Range("A" & Rows.count).End(3)(2)
    End If
Next i
End Sub

Hi John,
Perfect solution. Thanks. I have clicked * to thanks you.
May I also request you if I include any additional question on this ( related to change event or do you want me to post as a new thread?)
Thanks again
Regards

You're welcome. Glad to help out. Thanks for the feedback and the rep. I think it would be best for you to start a new thread for the change event question and mark this thread as solved. See Forum Rule 9 below.

9. Acknowledge the responses you receive, good or bad. If your problem is solved, please say so clearly, and mark your thread as Solved: Click Thread Tools above your first post, select "Mark your thread as Solved". Or click the Edit button on your first post in the thread, Click Go Advanced, select [SOLVED] from the Prefix dropdown, then click Save Changes. If more than two days have elapsed, the Dropdown option or Edit button will not appear -- ask a moderator to mark it.

Thanks John.
I am closing this one as solved. and post another one.
Thanks again for greate help
Regards

Perhaps this could also be a possible solution?

Sub Another()

    Range("K200:S200").AutoFilter Field:=1, Criteria1:="1"
    AutoFilter.Range.Copy
    Range("A76").PasteSpecial Paste:=xlPasteAll
    AutoFilterMode = False
    Application.CutCopyMode = False

End Sub

Alf

Hi Alf,
Thanks for your help. Apology for a late reply.
This does not work as intended.
Steps that I want to achieve are...
1. check range AF400:AF514 for any values of 1
2. Then copy those respective rows ( from AH:AN), where value of respective AF cell is 1
3. Paste it in range A:G in the next available row without loosing the reference
( right now John's code works very fine, however I am now getting REF errors )
I have also requested John for more help.
I will be very thankful if I am able to resolve it with both of your help...
Thanks again
kind regards

Hi John and Alf,
Any help yet
please?
Regards

Maybe:

Sub KK1234z()
Dim i As Long
For i = 400 To 511
    If Range("AF" & i).Value = 0 Then
        Range("A" & Rows.count).End(3)(2).Resize(, 7).Value = Range(Range("AF" & i).Offset(, 2), Range("AF" & i).Offset(, 8)).Value
    End If
Next i
End Sub

Hi John,
Very well done sir.
Wow.
It now works great
Apology that it took a while for me to understand.
Thanks for your great support.
Nice to interact with you John.
Kind regards
KK1234

Once again welcome. Glad to hear it worked for you. Sorry, it took so long too respond, but I've been offline for awhile.

Thanks John again