Copy and Find Based on values and paste in different sheet

[srikanth sare]

The Below code is To Copy Sheet from Different Workbook and paste it current workbook Then
Find the Value In a specific Column if the value is found then copy the entire row and Union of rows to be pasted in a different sheet.

But the below code is working properly. it does copy the found values

Public Function SheetFromCodeName(Name As String, wbK As Workbook) As Worksheet
    Dim Wks As Worksheet
    For Each Wks In wbK.Worksheets
        If Wks.CodeName = Name Then
           Set SheetFromCodeName = Wks
           Exit For
        End If
    Next Wks
End Function
Private Sub a()

    Dim wbK As Workbook, Wks As Worksheet, fName As String, cop1 As String, cop2 As String, C As Range, N As Long
    Application.Run "TurnOff"
    Sheet42.Range("A6:EC9999").Clear
   
    For Each C In Sheet2.Range("K1:AT1")
    If C.Value <> "" Then
      fName = ThisWorkbook.Path & "\" & C.Value & ".xlsb"
      If Dir(fName) <> "" Then
        Set wbK = Workbooks.Open(fName, Password:="Ssca@1818", WriteResPassword:="Ssca@1818", UpdateLinks:=0)
        Set Wks = SheetFromCodeName("Sheet5", wbK)
        Sheet41.Range("A:EC").EntireColumn.Hidden = False
        Sheet41.Cells.Clear
        Wks.Unprotect "1818"
        Wks.Cells.Copy
        Sheet41.Range("A1").PasteSpecial xlPasteValues
        Sheet41.Range("A1").PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
           
        Dim xRg, raSource  As Range
        Dim i, lr As Long
        Dim MyValue        As Variant
   
        i = Sheet41.UsedRange.Rows.Count
        Set xRg = Union(Sheet41.Range("BX6:BX" & i), Sheet41.Range("BZ6:BZ" & i), Sheet41.Range("CB6:CB" & i), Sheet41.Range("CD6:CD" & i), Sheet41.Range("CF6:CF" & i), Sheet41.Range("CH6:CH" & i), _
                        Sheet41.Range("CJ6:CJ" & i), Sheet41.Range("CL6:CL" & i), Sheet41.Range("CN6:CN" & i), Sheet41.Range("CP6:CP" & i), Sheet41.Range("CR6:CR" & i), Sheet41.Range("CT6:CT" & i), _
                        Sheet41.Range("CV6:CV" & i), Sheet41.Range("CX6:CX" & i), Sheet41.Range("CZ6:CZ" & i), Sheet41.Range("DB6:DB" & i))
                       
        MyValue = Sheet44.Range("K1").Value
        For N = 1 To xRg.Rows.Count
            For Each KCELL In Intersect(xRg, xRg.Rows(N).EntireRow)
                If KCELL.Value = MyValue Then
                    If raSource Is Nothing Then
                        Set raSource = Range(Cells(KCELL.Row, 1), Cells(KCELL.Row, 133))
                    Else
                        Set raSource = Union(raSource, Range(Cells(KCELL.Row, 1), Cells(KCELL.Row, 133)))
                    End If
                    Exit For
                End If
            Next
        Next N
       
        raSource.Copy         ' getting error here
        lr = Sheet42.Range("A:EC").Find("*", , xlValues, , xlByRows, xlPrevious).Row
        If lr < 6 Then
        Sheet42.Range("A6").PasteSpecial xlPasteAllUsingSourceTheme
        Else
        Sheet42.Range("A" & lr).PasteSpecial xlPasteAllUsingSourceTheme
        End If
        Application.CutCopyMode = False
        Sheet42.Activate
        wbK.Close False
        Set raSource = Nothing
        cop1 = cop1 & C.Value & vbCr
      Else
        cop2 = cop2 & C.Value & vbCr
      End If
    End If
    Next
   
    Application.Run "TurnOn"
    MsgBox "Copied Books" & vbCr & cop1 & vbCr & "These books do not exist" & vbCr & cop2
   
End Sub

 

[srikanth sare]

Help me on this error Bro!!