Hello
I want modifying code to brings data in sheet name DATA in main file when select folder to pull data from sheet name DATA in all of files are existed in selected folder instead of add sheet name like DATA(1) ,DATA(2) ....so on after first sheet name DATA and combining values in columns C,D for duplicates items based on matching ID for column B and autonumbering in column A.
thanks
I want modifying code to brings data in sheet name DATA in main file when select folder to pull data from sheet name DATA in all of files are existed in selected folder instead of add sheet name like DATA(1) ,DATA(2) ....so on after first sheet name DATA and combining values in columns C,D for duplicates items based on matching ID for column B and autonumbering in column A.
VBA Code:
Sub test()
Dim FSO As Object, FolDir As Object, FileNm As Object
Dim TargetFolder As FileDialog, Sht As Worksheet, Cnter As Integer
Set TargetFolder = Application.FileDialog(msoFileDialogFolderPicker)
With TargetFolder
.AllowMultiSelect = False
.Title = "Select Folder:"
.Show
End With
If TargetFolder.SelectedItems.Count = 0 Then
MsgBox "PICK A Folder!"
Exit Sub
End If
On Error GoTo Erfix
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set FSO = CreateObject("scripting.filesystemobject")
Set FolDir = FSO.GetFolder(Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1))
For Each FileNm In FolDir.Files
If FileNm.Name Like "*" & ".xls" & "*" Then
Workbooks.Open Filename:=FileNm
For Each Sht In Workbooks(FileNm.Name).Worksheets
If LCase(Sht.Name) = LCase("Data") Then
Cnter = Cnter + 1
Workbooks(FileNm.Name).Sheets("Data").copy _
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Sht.Name = "Data" & Cnter
Workbooks(FileNm.Name).Close savechanges:=False
Exit For
End If
Next Sht
End If
Next FileNm
Erfix:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set FolDir = Nothing
Set FSO = Nothing
End Sub