# change code to comine data in the  same sheet instead of  add sheets



## KalilMe (Dec 12, 2022)

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.





```
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
```
thanks


----------



## HaHoBe (Dec 13, 2022)

Hi KalilMe,

maybe


```
Sub test_mod()
' https://www.mrexcel.com/board/threads/change-code-to-comine-data-in-the-same-sheet-instead-of-add-sheets.1224447/
Dim FSO As Object
Dim FolDir As Object
Dim FileNm As Object
Dim TargetFolder As FileDialog
Dim Sht As Worksheet
Dim wksColl As Worksheet
Dim blnDel As Boolean

Set wksColl = Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
blnDel = True

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
        Sht.UsedRange.Copy wksColl.Range("A" & wksColl.Rows.Count).End(xlUp).Offset(1, 0)
        blnDel = False
        Workbooks(FileNm.Name).Close savechanges:=False
        Exit For
      End If
    Next Sht
  End If
Next FileNm

Erfix:
If blnDel Then wksColl.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set wksColl = Nothing
Set FolDir = Nothing
Set FSO = Nothing
Set TargetFolder = Nothing
End Sub
```

Ciao,
Holger


----------



## KalilMe (Dec 13, 2022)

very good  try buddy !
I  have  somthings  to  make  clearing:
1-  the  main  file  where run  the  macro  contains  sheet DATA  , so  just  brings  data from  multiple  files  for  sheet DATA  without  add  any  sheet, in  reality  your  version  will  add  sheet  and  brings  data  after  existed sheet name DATA .
2- should  ignore  the  headers , your  version  will also  copy  headers.
3- this  part  seems  difficult . as  I said  there  is  duplicats  items  so  I  want  summing  the  values for  column C,D  for  duplicates items  based on  matching  column B
I  hope  you  can  help


----------



## HaHoBe (Dec 13, 2022)

Hi KalilMe,

getting the data in a form that you like could be done like this:


```
Sub test_mod_Vers2()
' https://www.mrexcel.com/board/threads/change-code-to-comine-data-in-the-same-sheet-instead-of-add-sheets.1224447/
Dim FSO As Object
Dim FolDir As Object
Dim FileNm As Object
Dim TargetFolder As FileDialog
Dim Sht As Worksheet
Dim wksColl As Worksheet

On Error GoTo Erfix
Set wksColl = ThisWorkbook.Worksheets("Data")

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

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
        Sht.UsedRange.Offset(1).Copy wksColl.Range("B" & wksColl.Rows.Count).End(xlUp).Offset(1, 0)
        Workbooks(FileNm.Name).Close savechanges:=False
        Exit For
      End If
    Next Sht
  End If
Next FileNm

Erfix:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set wksColl = Nothing
Set FolDir = Nothing
Set FSO = Nothing
Set TargetFolder = Nothing
End Sub
```

But I have trouble understanding what you want to be summed: the values in Column C as well as D indepently for the whole area just copied? Or summed up by anything like an ID in  Column B (but in which column)? And the numbering: each area on it's own or going through?

Maybe you can attach the information by using XL2BB (or via picture).

Holger


----------



## KalilMe (Dec 13, 2022)

> But I have trouble understanding what you want to be summed: the values in Column C as well as D indepently for the whole area just copied? Or summed up by anything like an ID in Column B (but in which column)? And the numbering: each area on it's own or going through?
> 
> Maybe you can attach the information by using XL2BB (or via picture).


here  is  data for  the  some  files in folder

first file
MAS.xlsmABCD1ITEMCODEINPUTOUTPUT21F00D-BANANA-1101032F00D-BANANA-22043F00D-BANANA-33054F00D-BANANA-440265F00D-BANANA-550276F00D-BANANA-660287F00D-BANANA-77098F00D-BANANA-88012109F00D-BANANA-990131110F00D-BANANA-10100451211F00D-BANANA-11110661312F00D-BANANA-12120541413F00D-BANANA-1313021514F00D-BANANA-1414031615F00D-BANANA-151501716F00D-BANANA-161601817F00D-BANANA-17170121918F00D-BANANA-1818012DATA

second  file
LAST.xlsmABCD1ITEMCODEINPUTOUTPUT21F00D-BANANA-71232F00D-BANANA-81143F00D-BANANA-99054F00D-BANANA-22065F00D-BANANA-312176F00D-BANANA-41287F00D-BANANA-512298F00D-BANANA-6452109F00D-BANANA-133101110F00D-BANANA-1066451211F00D-BANANA-1177661312F00D-BANANA-1288541413F00D-BANANA-1313021514F00D-BANANA-1414031615F00D-BANANA-151501716F00D-BANANA-161601817F00D-BANANA-17170121918F00D-BANANA-1818012DATA
result   in file  master  after  summing  in  column C,D for  duplicates  items  based on  column B with  re-autonumbering  in  column A
MASTER.xlsmABCD1ITEMCODEINPUTOUTPUT21F00D-BANANA-1432032F00D-BANANA-240043F00D-BANANA-342154F00D-BANANA-441465F00D-BANANA-562476F00D-BANANA-6105487F00D-BANANA-782098F00D-BANANA-89112109F00D-BANANA-9180131110F00D-BANANA-10166901211F00D-BANANA-111871321312F00D-BANANA-122081081413F00D-BANANA-1326041514F00D-BANANA-1428061615F00D-BANANA-1530001716F00D-BANANA-1632001817F00D-BANANA-17340241918F00D-BANANA-1836024DATA
I hope  this  help


----------



## HaHoBe (Dec 13, 2022)

Hi KalilMe,

using standard VBA commands like


```
Sub test_mod_Vers3()
' https://www.mrexcel.com/board/threads/change-code-to-comine-data-in-the-same-sheet-instead-of-add-sheets.1224447/
Dim FSO As Object
Dim FolDir As Object
Dim FileNm As Object
Dim TargetFolder As FileDialog
Dim Sht As Worksheet
Dim wksColl As Worksheet
Dim lngRow As Long

On Error GoTo Erfix
Set wksColl = ThisWorkbook.Worksheets("Data")

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

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
        Sht.UsedRange.Offset(1).Copy wksColl.Range("A" & wksColl.Rows.Count).End(xlUp).Offset(1, 0)
        Workbooks(FileNm.Name).Close savechanges:=False
        Exit For
      End If
    Next Sht
  End If
Next FileNm

wksColl.Range("A1").CurrentRegion.Sort Key1:=Range("B1"), _
      Order1:=xlAscending, _
      Header:=xlYes, _
      OrderCustom:=1, _
      MatchCase:=False, _
      Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal

For lngRow = wksColl.Cells(wksColl.Rows.Count, "B").End(xlUp).Row To 3 Step -1
  With wksColl.Cells(lngRow, "B")
    If .Value = .Offset(-1, 0).Value Then
      .Offset(-1, 1).Value = .Offset(-1, 1).Value + .Offset(, 1).Value
      .Offset(-1, 2).Value = .Offset(-1, 2).Value + .Offset(, 2).Value
      .EntireRow.Delete
    End If
  End With
Next lngRow

wksColl.Range("A1").CurrentRegion.Sort Key1:=Range("A1"), _
      Order1:=xlAscending, _
      Header:=xlYes, _
      OrderCustom:=1, _
      MatchCase:=False, _
      Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal

wksColl.Range("A1:D1").EntireColumn.AutoFit

Erfix:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set wksColl = Nothing
Set FolDir = Nothing
Set FSO = Nothing
Set TargetFolder = Nothing
End Sub
```

Ciao,
Holger


----------



## KalilMe (Dec 13, 2022)

awesome !
just  two  things:
1-  I  want  clearing   data  from row2   in  file  MASTER  before  bring  data because I note to  repeat summing over values are already existed  repeatedly .
2-  I  want  sort  data  from small to  big  after  merging
thanks   for  your  time .


----------



## HaHoBe (Dec 13, 2022)

Hi KalilMe,

two small adjustments to the code:


```
Sub test_mod_Vers4()
' https://www.mrexcel.com/board/threads/change-code-to-comine-data-in-the-same-sheet-instead-of-add-sheets.1224447/
Dim FSO As Object
Dim FolDir As Object
Dim FileNm As Object
Dim TargetFolder As FileDialog
Dim Sht As Worksheet
Dim wksColl As Worksheet
Dim lngRow As Long

On Error GoTo Erfix
Set wksColl = ThisWorkbook.Worksheets("Data")
'/// clear the used range but keep headings
wksColl.UsedRange.Offset(1, 0).ClearContents

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

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
        Sht.UsedRange.Offset(1).Copy wksColl.Range("A" & wksColl.Rows.Count).End(xlUp).Offset(1, 0)
        Workbooks(FileNm.Name).Close savechanges:=False
        Exit For
      End If
    Next Sht
  End If
Next FileNm

wksColl.Range("A1").CurrentRegion.Sort Key1:=Range("B1"), _
      Order1:=xlAscending, _
      Header:=xlYes, _
      OrderCustom:=1, _
      MatchCase:=False, _
      Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal

For lngRow = wksColl.Cells(wksColl.Rows.Count, "B").End(xlUp).Row To 3 Step -1
  With wksColl.Cells(lngRow, "B")
    If .Value = .Offset(-1, 0).Value Then
      .Offset(-1, 1).Value = .Offset(-1, 1).Value + .Offset(, 1).Value
      .Offset(-1, 2).Value = .Offset(-1, 2).Value + .Offset(, 2).Value
      .EntireRow.Delete
    End If
  End With
Next lngRow

'/// change Column to suit, here it is for sorting Input low to high
wksColl.Range("A1").CurrentRegion.Sort Key1:=Range("C1"), _
      Order1:=xlAscending, _
      Header:=xlYes, _
      OrderCustom:=1, _
      MatchCase:=False, _
      Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal

wksColl.Range("a1:D1").EntireColumn.AutoFit
  
Erfix:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set wksColl = Nothing
Set FolDir = Nothing
Set FSO = Nothing
Set TargetFolder = Nothing
End Sub
```

Ciao,
Holger


----------



## KalilMe (Dec 14, 2022)

thanks gain 
just  I  need  fixing  the  sort, doesn't  seem arranging  correctly
this  is  what  I got 
MASTER.xlsmABCD1ITEMCODEINPUTOUTPUT24F00D-BANANA-240036F00D-BANANA-441445F00D-BANANA-342159F00D-BANANA-1432067F00D-BANANA-562471F00D-BANANA-782082F00D-BANANA-8911298F00D-BANANA-610541010F00D-BANANA-1016690113F00D-BANANA-9180131211F00D-BANANA-111871321312F00D-BANANA-122081081413F00D-BANANA-1326041514F00D-BANANA-1428061615F00D-BANANA-1530001716F00D-BANANA-1632001817F00D-BANANA-17340241918F00D-BANANA-1836024DATA


----------



## HaHoBe (Dec 14, 2022)

Hi KalilMe,



> just  I  need  fixing  the  sort, doesn't  seem arranging  correctly



Please be more precise when asking for



> 2-  I  want  sort  data  from small to  big  after  merging



What column/item? And don't post what you have but what the outcome should look like: the original request how data should look like was posted by you in #5, you are asking for something different than that by now.

Holger


----------



## KalilMe (Dec 12, 2022)

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.





```
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
```
thanks


----------



## KalilMe (Dec 14, 2022)

> but what the outcome should look like: the original request how data should look like was posted by you in #5


yes surely 


> you are asking for something different than that by now.


no ,just  see  the  picture in post#9   starts  sorting   based  on  column B F00-BANANA2 ,3,4 
and  in post #5 should  be F00-BANANA1 ,2,3 from small to big 
and  should  re-autonumbering 1,2,3  in  column A after brings data into file  MASTER   . it  seems to  brings  ITEMS   from  sources  files  as  they  are.


----------



## HaHoBe (Dec 14, 2022)

Hi KalilMe,

like this:

MrE_1224447_1615B0E_change code to comin_221213.xlsmABCD1ITEMCODEINPUTOUTPUT21F00D-BANANA-240032F00D-BANANA-441443F00D-BANANA-342154F00D-BANANA-1432065F00D-BANANA-5624Data


```
Sub test_mod_Vers5()
' https://www.mrexcel.com/board/threads/change-code-to-comine-data-in-the-same-sheet-instead-of-add-sheets.1224447/
Dim FSO As Object
Dim FolDir As Object
Dim FileNm As Object
Dim TargetFolder As FileDialog
Dim Sht As Worksheet
Dim wksColl As Worksheet
Dim lngRow As Long

On Error GoTo Erfix
Set wksColl = ThisWorkbook.Worksheets("Data")
'/// clear the used range but keep headings
wksColl.UsedRange.Offset(1, 0).ClearContents

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

With Application
  .ScreenUpdating = False
  .DisplayAlerts = False
End With

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
        Sht.UsedRange.Offset(1).Copy wksColl.Range("A" & wksColl.Rows.Count).End(xlUp).Offset(1, 0)
        Workbooks(FileNm.Name).Close savechanges:=False
        Exit For
      End If
    Next Sht
  End If
Next FileNm

With wksColl
  .Range("A1").CurrentRegion.Sort Key1:=Range("B1"), _
      Order1:=xlAscending, _
      Header:=xlYes, _
      OrderCustom:=1, _
      MatchCase:=False, _
      Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal

  For lngRow = .Cells(.Rows.Count, "B").End(xlUp).Row To 3 Step -1
    With .Cells(lngRow, "B")
      If .Value = .Offset(-1, 0).Value Then
        .Offset(-1, 1).Value = .Offset(-1, 1).Value + .Offset(, 1).Value
        .Offset(-1, 2).Value = .Offset(-1, 2).Value + .Offset(, 2).Value
        .EntireRow.Delete
      End If
    End With
  Next lngRow

  '/// change Column to suit, here it is for sorting Input low to high
  .Range("A1").CurrentRegion.Sort Key1:=Range("C1"), _
      Order1:=xlAscending, _
      Header:=xlYes, _
      OrderCustom:=1, _
      MatchCase:=False, _
      Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal

  '/// new numbering
  With .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
    .Formula = "=Row()-1"
    .Value = .Value
  End With
  
  .Range("A1:D1").EntireColumn.AutoFit
End With

Erfix:
With Application
  .DisplayAlerts = True
  .ScreenUpdating = True
End With
Set wksColl = Nothing
Set FolDir = Nothing
Set FSO = Nothing
Set TargetFolder = Nothing
End Sub
```

Holger


----------



## KalilMe (Dec 14, 2022)

I appreciate  for  your  efforts , but  truly  I'm  surprised  from  post#5  is  not  clear  for  you .
based  on  my  last  post  should  be  like  in  post #5 , just  comapre the  column B  between  two  pictures .
MASTER.xlsmABCD1ITEMCODEINPUTOUTPUT21F00D-BANANA-1432032F00D-BANANA-240043F00D-BANANA-342154F00D-BANANA-441465F00D-BANANA-562476F00D-BANANA-6105487F00D-BANANA-782098F00D-BANANA-89112109F00D-BANANA-9180131110F00D-BANANA-10166901211F00D-BANANA-111871321312F00D-BANANA-122081081413F00D-BANANA-1326041514F00D-BANANA-1428061615F00D-BANANA-1530001716F00D-BANANA-1632001817F00D-BANANA-17340241918F00D-BANANA-1836024DATA
basd  on  your  last  version  and  guiding  my  how  change  the  column sorting by  your  comments  this  is  what  I got 
MASTER.xlsmABCD1ITEMCODEINPUTOUTPUT21F00D-BANANA-1432032F00D-BANANA-101669043F00D-BANANA-1118713254F00D-BANANA-1220810865F00D-BANANA-13260476F00D-BANANA-14280687F00D-BANANA-15300098F00D-BANANA-163200109F00D-BANANA-17340241110F00D-BANANA-18360241211F00D-BANANA-24001312F00D-BANANA-34211413F00D-BANANA-44141514F00D-BANANA-56241615F00D-BANANA-610541716F00D-BANANA-78201817F00D-BANANA-891121918F00D-BANANA-918013DATA


----------



## HaHoBe (Dec 14, 2022)

Sorry but I lost track of what you want.

Holger


----------



## HaHoBe (Dec 14, 2022)

Hi KalilMe,

thinking about your request I believe Vers3 to have been pretty near to what you wanted. Please find the code with some comments (finally sorting on Column A):


```
Sub MrE_1224447_1615B0E()
' https://www.mrexcel.com/board/threads/change-code-to-comine-data-in-the-same-sheet-instead-of-add-sheets.1224447/
  Dim objFSO            As Object
  Dim objFolDir         As Object
  Dim objFile           As Object
  Dim objFileDialog     As FileDialog
  Dim wks               As Worksheet
  Dim wksColl           As Worksheet
  Dim lngRow            As Long

  On Error GoTo Erfix
  Set wksColl = ThisWorkbook.Worksheets("Data")
  '/// clear the used range but keep headings
  wksColl.UsedRange.Offset(1, 0).ClearContents
  
  Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
  With objFileDialog
    .AllowMultiSelect = False
    .Title = "Select Folder:"
    .Show
  End With
  If objFileDialog.SelectedItems.Count = 0 Then
    MsgBox "PICK A Folder!"
    Exit Sub
  End If
  
  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
  End With
  
  Set objFSO = CreateObject("scripting.filesystemobject")
  Set objFolDir = objFSO.GetFolder(Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1))
  For Each objFile In objFolDir.Files
    If objFile.Name Like "*" & ".xls" & "*" Then
      Workbooks.Open Filename:=objFile
      For Each wks In Workbooks(objFile.Name).Worksheets
        If LCase(wks.Name) = LCase("Data") Then
          wks.UsedRange.Offset(1).Copy wksColl.Range("A" & wksColl.Rows.Count).End(xlUp).Offset(1, 0)
          Workbooks(objFile.Name).Close savechanges:=False
          Exit For
        End If
      Next wks
    End If
  Next objFile
  
  With wksColl
    '/// sort the data under the headers for Column B (Code)
    .Range("A1").CurrentRegion.Sort Key1:=Range("B1"), _
        Order1:=xlAscending, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
  
    '/// loop from the bottom to the top to merge the values for Input and Output
    '/// as well as take care that there will always be only one row left
    For lngRow = .Cells(.Rows.Count, "B").End(xlUp).Row To 3 Step -1
      With .Cells(lngRow, "B")
        If .Value = .Offset(-1, 0).Value Then
          .Offset(-1, 1).Value = .Offset(-1, 1).Value + .Offset(, 1).Value
          .Offset(-1, 2).Value = .Offset(-1, 2).Value + .Offset(, 2).Value
          .EntireRow.Delete
        End If
      End With
    Next lngRow
   
    '/// depending on what the data should be sorted on:
    '/// Item     Column 1 or A: Range("A1")
    '/// Input    Column 3 or C: Range("C1")
    '/// Output   Column 4 or D: Range("D1")
    '/// change Key1 to suit
    .Range("A1").CurrentRegion.Sort Key1:=Range("A1"), _
        Order1:=xlAscending, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
  
    .UsedRange.Rows(1).EntireColumn.AutoFit
  End With
  
Erfix:
  With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
  End With
  Set wksColl = Nothing
  Set objFolDir = Nothing
  Set objFSO = Nothing
  Set objFileDialog = Nothing
End Sub
```

Ciao,
Holger


----------



## KalilMe (Dec 15, 2022)

thanks , it  gives  the  same  result 

```
[RANGE=rs:19|cs:4|w:MASTER.xlsm|cls:xl2bb-200|s:DATA|tw:170][XR][XH][/XH][XH=w:25]A[/XH][XH=w:76]B[/XH][XH=w:30]C[/XH][XH=w:38]D[/XH][/XR][XR][XH]1[/XH][XD=h:c|v:m|fw:b|bc:FFFF00|ch:15|fz:10pt|cls:bl bt br bb ww]ITEM[/XD][XD=h:c|v:m|fw:b|bc:FFFF00|fz:10pt|cls:bl bt br bb ww]CODE[/XD][XD=h:c|v:m|fw:b|bc:FFFF00|fz:10pt|cls:bl bt br bb ww]INPUT[/XD][XD=h:c|v:m|fw:b|bc:FFFF00|fz:10pt|cls:bl bt br bb ww]OUTPUT[/XD][/XR][XR][XH]2[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]1[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-7[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]82[/XD][XD=v:m|cls:bl bt br bb ww]0[/XD][/XR][XR][XH]3[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]2[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-8[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]91[/XD][XD=v:m|cls:bl bt br bb ww]12[/XD][/XR][XR][XH]4[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]3[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-9[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]180[/XD][XD=v:m|cls:bl bt br bb ww]13[/XD][/XR][XR][XH]5[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]4[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-2[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]40[/XD][XD=v:m|cls:bl bt br bb ww]0[/XD][/XR][XR][XH]6[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]5[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-3[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]42[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]1[/XD][/XR][XR][XH]7[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]6[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-4[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]41[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]4[/XD][/XR][XR][XH]8[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]7[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-5[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]62[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]4[/XD][/XR][XR][XH]9[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]8[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-6[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]105[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]4[/XD][/XR][XR][XH]10[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]9[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-1[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]43[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]20[/XD][/XR][XR][XH]11[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]10[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-10[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]166[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]90[/XD][/XR][XR][XH]12[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]11[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-11[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]187[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]132[/XD][/XR][XR][XH]13[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]12[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-12[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]208[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]108[/XD][/XR][XR][XH]14[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]13[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-13[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]260[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]4[/XD][/XR][XR][XH]15[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]14[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-14[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]280[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]6[/XD][/XR][XR][XH]16[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]15[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-15[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]300[/XD][XD=v:m|cls:bl bt br bb ww]0[/XD][/XR][XR][XH]17[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]16[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-16[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]320[/XD][XD=v:m|cls:bl bt br bb ww]0[/XD][/XR][XR][XH]18[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]17[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-17[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]340[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]24[/XD][/XR][XR][XH]19[/XH][XD=h:c|v:m|ch:15|fz:10pt|cls:bl bt br bb ww]18[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]F00D-BANANA-18[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]360[/XD][XD=h:c|v:m|fz:10pt|cls:bl bt br bb ww]24[/XD][/XR][/RANGE]
```

it  should  sort  from  small   to big  when to  see  the  last  number  for  the  item in  column B 

this  means to  will arrange  the  items  from less numbers  to  big  numbers  for  each  item .


----------



## HaHoBe (Dec 15, 2022)

Hi KalilMe,

my last try for it:


```
Sub MrE_1224447_1615B0E_221215()
' https://www.mrexcel.com/board/threads/change-code-to-comine-data-in-the-same-sheet-instead-of-add-sheets.1224447/
  Dim objFSO            As Object
  Dim objFolDir         As Object
  Dim objFile           As Object
  Dim objFileDialog     As FileDialog
  Dim wks               As Worksheet
  Dim wksColl           As Worksheet
  Dim lngRow            As Long
  Dim varRes            As Variant
  Dim rngCell           As Range
    
  On Error GoTo Erfix
  Set wksColl = ThisWorkbook.Worksheets("Data")
  '/// clear the used range but keep headings
  wksColl.UsedRange.Offset(1, 0).ClearContents
  
  Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
  With objFileDialog
    .AllowMultiSelect = False
    .Title = "Select Folder:"
    .Show
  End With
  If objFileDialog.SelectedItems.Count = 0 Then
    MsgBox "PICK A Folder!"
    Exit Sub
  End If
  
  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
  End With
  
  Set objFSO = CreateObject("scripting.filesystemobject")
  Set objFolDir = objFSO.GetFolder(Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1))
  For Each objFile In objFolDir.Files
    If objFile.Name Like "*" & ".xls" & "*" Then
      Workbooks.Open Filename:=objFile
      For Each wks In Workbooks(objFile.Name).Worksheets
        If LCase(wks.Name) = LCase("Data") Then
          wks.UsedRange.Offset(1).Copy wksColl.Range("A" & wksColl.Rows.Count).End(xlUp).Offset(1, 0)
          Workbooks(objFile.Name).Close savechanges:=False
          Exit For
        End If
      Next wks
    End If
  Next objFile
  
  With wksColl
    '/// sort the data under the headers for Column B (Code)
    .Range("A1").CurrentRegion.Sort Key1:=Range("B1"), _
        Order1:=xlAscending, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
  
    '/// loop from the bottom to the top to merge the values for Input and Output
    '/// as well as take care that there will always be only one row left
    For lngRow = .Cells(.Rows.Count, "B").End(xlUp).Row To 3 Step -1
      With .Cells(lngRow, "B")
        If .Value = .Offset(-1, 0).Value Then
          .Offset(-1, 1).Value = .Offset(-1, 1).Value + .Offset(, 1).Value
          .Offset(-1, 2).Value = .Offset(-1, 2).Value + .Offset(, 2).Value
          .EntireRow.Delete
        End If
      End With
    Next lngRow
   
    '/// splitting the Code to get the number into Column A
    For Each rngCell In .Range("B2:B" & .Cells(Rows.Count, 2).End(xlUp).Row)
      With rngCell
        varRes = Split(.Value, "-")
        .Offset(, -1).Value = CLng(varRes(UBound(varRes)))
      End With
    Next rngCell
    
    '/// depending on what the data should be sorted on:
    '/// Item     Column 1 or A: Range("A1")
    '/// Input    Column 3 or C: Range("C1")
    '/// Output   Column 4 or D: Range("D1")
    '/// change Key1 to suit
    .Range("A1").CurrentRegion.Sort Key1:=Range("A1"), _
        Order1:=xlAscending, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
  
    .UsedRange.Rows(1).EntireColumn.AutoFit
  End With
  
Erfix:
  With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
  End With
  Set wksColl = Nothing
  Set objFolDir = Nothing
  Set objFSO = Nothing
  Set objFileDialog = Nothing
End Sub
```

Holger


----------



## KalilMe (Dec 15, 2022)

finally it  succeeds !
much  appreciated  for  spending    your  time  to  solve it 
have  a good  day  buddy


----------

