distributing data from main sheet to many workbooks in folder based on partial name

Sub Test()

Dim sheetname As String
Dim SourcePath As String, DestPath As String, FName As String, sh As Worksheet, rng As Range, c As Range

SourcePath = "C:\Users\acc11.ANSARYNEW\Desktop\test\"


For Each sh In Worksheets


sheetname = sh.Name
sh.Range("a1", "f4").Copy


FName = dir(SourcePath & sheetname & "*.xls")


On Error Resume Next

Workbooks.Open SourcePath & FName
FName = dir()


ActiveWorkbook.Worksheets("1").Paste
Next sh


End Sub



this code open workbook that have part of the sheet name in the main workbook and copy data from each sheet but still can not copy the data that belongs each workbook accurately and past it in a specific range in the workbook