如果同一工作表上的另一个单元格值为true，则复制粘贴工作表中两个单元格的数据;但要粘贴在特定范围内的数据

Question

我需要将2个单元格的值粘贴到同一张纸上的不同目的地，并检查条件为真。

如果条件在列M上为真，则列K和L具有需要复制的数据。总数据范围是从K8到K18;同样适用于L和M.

如果列M的值是＆＃34; Y＆＃34;那么同一行的K和L的值需要粘贴到D和E列的同一张纸上，但它应该从第12行开始并粘贴任何其他值，如果＆＃34; Y＆＃34;彼此之间没有空白。

循环应该在第18行停止检查，并且数据不能粘贴到第22行之外。

请检查屏幕截图。  如果需要任何其他信息;请让我知道。

 Sub Search_and_Move()

Dim wsSource As Worksheet, wsDest As Worksheet
Dim FoundX As Range, Firstfound As String, Lastrow As Long

Set wsSource = Worksheets("Draft")     ' Source worksheet
Set wsDest = Worksheets("Draft")       ' Destination worksheet

' Find the first cell in column M with an "Y" in it
Set FoundX = wsSource.Range("M:M").Find("Y", After:=wsSource.Range("M" & Rows.Count), _
                             LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)

If FoundX Is Nothing Then

    MsgBox "No Y's found.", vbCritical, "Done!"
    Exit Sub

Else    'Copy values


    Firstfound = FoundX.Address                                     ' Remember the first found "Y" cell address. Prevents an endless loop.

    Lastrow = wsSource.Range("D" & Rows.Count).End(xlUp).Row + 1      ' Next empty row on Destination sheet
    If Lastrow < 11 Then Lastrow = 11

    Do

        'Copy K:L values from source worksheet to next empty row on the destination worksheet in columns D:E
        wsDest.Range("D" & Lastrow).Resize(1, 2).Value = FoundX.Offset(0, -2).Resize(1, 2).Value

        Lastrow = Lastrow + 1                                       ' Row counter

        Set FoundX = wsSource.Range("M:M").FindNext(FoundX)         ' Find next "Y" in column M

    Loop Until FoundX.Address = Firstfound                          ' Do until the first "Y" address is found again

End If

MsgBox "All Y values copied.", vbInformation, "Done!"

End Sub