Copy Selected Range From One Sheet To Multiple Workbooks Sheets Using VBA

[Excel Fox]

Try this

Sub TCall()

    CopyAndPasteToMultipleWorkbooks "SourceSheetName", "J:J", "DestinationSheetName", "DestinationRangeAddress"
    
End Sub


Sub CopyAndPasteToMultipleWorkbooks(strFromSheet As String, strFromRange As String, strToSheet As String, strToRange As String)
     
    Dim strFile As String
    Dim strFileType As String
    Dim strPath As String
    Dim lngLoop As Long
    Dim wbk As Workbook
    
    strPath = "C:\ExcelFox"
    strFileType = "Book*.xlsx" 'Split with semi-colon if you want to specify the file types. Example ->> "*.xls;*.doc"
     
    For lngLoop = LBound(Split(strFileType, ";")) To UBound(Split(strFileType, ";"))
        strFile = Dir(strPath & "\" & Split(strFileType, ";")(lngLoop))
        Do While strFile <> ""
            If strFile <> ThisWorkbook.Name Then
                Set wbk = Workbooks.Open(strPath & "\" & strFile, False, True)
                With wbk.Sheets(strToSheet)
                    ThisWorkbook.Worksheets(strFromSheet).Range(strFromRange).Copy .Range(strToRange)
                    .Parent.Close 1
                End With
            End If
        Loop
    Next lngLoop
     
    strFile = vbNullString
    strFileType = vbNullString
    strPath = vbNullString
    lngLoop = Empty
     
End Sub