Create new sheet and copy data from another worksheet if match conditions

[sbv1986]

Hi all
I have workbook main with sheet(data) and folder with a lot of excel file, all excel files the same structure
sheet(data).column(A) have range look like

	A
1	123456
2	124567
3	125678
4	126789
5	...
....	...
n	... and more to n = last row

<tbody>
</tbody>

Now I want to have macro to do brown to folder choose all excel file, If excel file name have string like value in column(A) then:
1. Adding new sheet with sheetname = Range(Ai) value
2. Copy range(C10:AC54) from excel file have string to new sheet has just adding

Thanks./.

 

[JLGWhiz]

You can try this.
Assuming that Workbook "main" is in the same folder as the files to retrieved.

Sub t()
Dim fName As String, fPath As String, msh As Worksheet, wb As Workbook, nm As String
Set msh = ThisWorkbook.Sheets("Data")
fPath = ThisWorkbook.Path & "\"
fName = Dir(fPath & "*.xls*")
    Do While fName <> ""
        nm = Left(fName, InStr(fName, ".") - 1)
        If fName <> ThisWorkbook.Name Then
            If Application.CountIf(msh.Range("A:A"), nm) > 0 Then
                ThisWorkbook.Sheets.Add After:=Sheets(ThisWorkbook.Sheets.Count)
                ActiveSheet.Name = nm
                Set wb = Workbooks.Open(fPath & fName)
                wb.Sheets(1).Range("C10:AC54").Copy ThisWorkbook.Sheets(nm).Range("C10") 'Might need to adjust
                wb.Close False
            End If
        End If
        fName = Dir
    Loop
End Sub

 

[sbv1986]

Thanks JLGWhiz for your respond, I do as your suggues but there's nothing happen.

 

[JLGWhiz]

Thanks JLGWhiz for your respond, I do as your suggues but there's nothing happen.

Then I have not interpreted your objective correctily. Without accurate sheet, file, directory and data layout specifications, I cannot offer anything better. Sorry.
Regards, JLG

 

[sbv1986]

Then I have not interpreted your objective correctily. Without accurate sheet, file, directory and data layout specifications, I cannot offer anything better. Sorry.
Regards, JLG

I've just found the way to run your code with a small change

Sub t()Dim fName As String, fPath As String, msh As Worksheet, wb As Workbook, nm As String
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
Set msh = ThisWorkbook.Sheets("Data")
Application.ScreenUpdating = False
fPath = ThisWorkbook.Path & "\"
InitialFoldr$ = fPath
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to list Files from"
        .InitialFileName = InitialFoldr$
        .Show
        If .SelectedItems.Count <> 0 Then
        fName = Dir(fPath & "*.xl*")
        Do While fName <> ""
        nm = Mid(fName, 8, 6)
        If fName <> ThisWorkbook.Name Then
            If Application.CountIf(msh.Range("A:A"), nm) > 0 Then
                ThisWorkbook.Sheets.Add After:=Sheets(ThisWorkbook.Sheets.Count)
                On Error Resume Next
                ActiveSheet.Name = nm
                On Error GoTo 0
                Set wb = Workbooks.Open(fPath & fName)
                [COLOR=#333333]wb.Sheets(1).Range("C10:AC54").Copy ThisWorkbook.Sheets(nm).Range("C10") 'Might need to adjust[/COLOR]
                wb.Close False
            End If
        End If
        fName = Dir
    Loop
    End If
    End With
Application.ScreenUpdating = True
End Sub

Important I change

[COLOR=#333333]nm = Left(fName, InStr(fName, ".") - 1)[/COLOR]

to

nm = Mid(fName, 8, 6)

This work well with file have name like xxxxxxx123456yyyyyyyyy.xlsx
But when file name like xxx123456yyyyyyyyy.xlsx code don't work

Do you have any way to do with code I've just find above? JLGWhiz