Workbook Data Into One Single Sheet,Sort Alphabetic​ally ,Row column height width manipulation -MS Excel

Workbook Data Into One Single Sheet using MS Excel 

If you have 10 workbook each workbook have single sheet of data (tab name should be anything)
if you need consolidation sheet into all 10 workbook into one then you can do this with code use below mention code and your work will done .

 Sub test()  
 Dim FS, Fle, FLDR, fles  
 Dim Fletype As Variant  
 Set FS = CreateObject("scripting.filesystemobject&quot ;)  
 Dim intLstrow As Integer  
 Dim intLstcol As Integer  
 Dim dlgDialoge As FileDialog  
 Dim srcsheet As Worksheet  
 Dim wk As Workbook  
 'Set dlgDialoge = Application.FileDialog(msoFileDialogFolderPicker)  
 Set wk = ThisWorkbook  
 Set FLDR = FS.getfolder(BrowseFolder)  
 Set fles = FLDR.Files  
 For Each Fle In fles  
 Fletype = Split(Fle.Name, ".")  
 If (Fletype(UBound(Fletype)) = "xls" Or Fletype(UBound(Fletype)) =  
 "xlsx") Then  
 Set srcsheet = Workbooks.Open(Fle.path).Worksheets(1)  
 intLstrow = srcsheet.Range("a" &  
 Application.Rows.Count).End(xlUp).Row  
 intLstcol = srcsheet.Range("a" &  
 Application.Columns.Count).End(xlUp).Column  
 srcsheet.Range((Cells(1, 1)), Cells(intLstrow,  
 intLstcol)).Copy  
 wk.Worksheets("BrowseFileFolders").Range ("a" &  
 wk.Worksheets("BrowseFileFolders").Range ("a" &  
 Application.Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues  
 srcsheet.Parent.Close  
 End If  
 Next  
 End Sub  
 Public Function BrowseFolder(Optional initialPath As String = "") As String  
 Dim dialog As FileDialog  
 Set dialog = Application.FileDialog(msoFileDialogFolderPicker)  
 dialog.InitialFileName = initialPath  
 dialog.Show  
 If dialog.SelectedItems.Count > 0 Then  
 BrowseFolder = dialog.SelectedItems(1)  
 End If  
 End Function  

Sort Alphabetic​ally in Tab Order for Worksheets

To Sort Alphabetic​ally in Tab Order for Worksheets in Excel you can try following vba code in your macro code editor.

  Dim nameOfSheet As String  
    Dim newNameOfSheet As String  
   Dim haveName As Boolean  
   Dim extension As Integer  
   haveName = False  
   Do While (Not haveName)  
     nameOfSheet = InputBox("Enter a sheet name")  
     If checksheet(nameOfSheet) Then  
       extension = 0  
       If MsgBox("That name is already in use. Do you want a duplicate name?", vbYesNo) Then  
         Do While (Not haveName)  
           newNameOfSheet = nameOfSheet & " (" & extension & ")"  
           If checksheet(newNameOfSheet) Then  
             extension = extension + 1  
           Else  
             haveName = True  
           End If  
         Loop  
       End If  
     Else  
       haveName = True  
     End If  
   Loop  

Row column height width manipulation in Excel by macro code

Row column height width manipulation in Excel by macro code you can take help by following code

 Dim wb As Workbook  
 Dim ws As Worksheet  
 Dim c As Range  
 Dim r As Range  
 Dim strDescription As String  
 ' Suppress screen updating  
 Application.ScreenUpdating = False  
 ' Set workbook object  
 Set wb = Excel.ActiveWorkbook  
 ' Set worksheet object  
 Set ws = wb.ActiveSheet  
 ' Loop through each row  
 For Each r In ws.Rows.Range("1:" & xlLastCell)  
 ' Concatenate values from cells C-L into cell M  
 strDescription = ""  
 For Each c In ws.Range("C" & r.Row & ":" & "L" & r.Row)  
 strDescription = strDescription + c.Value  
 Next c  
 ws.Range("M" & r.Row).Value = strDescription  
 Next r  
 ' Format column M  
 With ws.Range("M:M")  
 .ColumnWidth = "60"  
 .WrapText = True  
 End With  
 ' Clear values in columns C-L  
 With ws.Range("C:L")  
 .ColumnWidth = "1"  
 .WrapText = False  
 .Value = ""  
 End With  

Support function in excel micro

 Function ColumnRange(ByVal Filename As String, ByVal Rangehead As String) As String  
 Dim r As Range  
 Dim ic As Integer  
 Dim rt As String  
 Dim CN As String  
 Set r = Worksheets(Filename).Range("A1:" & LastCol(Filename) & "1")  
 For i = 1 To r.Count  
 If Rangehead = r(1, i) Then  
 ic = i  
 i = r.Count  
 End If  
 Next  
 If ic = 0 Then  
 rt = ""  
 Else  
 CN = ConvertToLetter(ic)  
 rt = CN & "2:" & CN & LastRow(Filename)  
 End If  
 ColumnRange = rt  
 End Function  
 Function ColumnAddress(ByVal Filename As String, ByVal Rangehead As String) As String  
 Dim r As Range  
 Dim ic As Integer  
 Dim rt As String  
 Set r = Worksheets(Filename).Range("A1:" & LastCol(Filename) & "1")  
 For i = 1 To r.Count  
 If Rangehead = r(1, i) Then  
 ic = i  
 i = r.Count  
 End If  
 Next  
 If ic = 0 Then  
 rt = ""  
 Else  
 rt = ConvertToLetter(ic)  
 End If  
 ColumnAddress = rt  
 End Function  
 Function SVlookup(ByVal destflnm As String, ByVal DestRg As String, ByVal srcflnm As String, ByVal SrcRg As String) As String  
 Dim RgVal As Range  
 'Set Value Range using filename and cell range  
 Set RgVal = Worksheets(destflnm).Range(DestRg)  
 Dim RgVlookup As Range  
 'Set Value Range using filename and cell range  
 Set RgVlookup = Worksheets(srcflnm).Range(SrcRg)  
 'return lookup value  
 SVlookup = WorksheetFunction.VLookup(RgVal, RgVlookup, 2, False)  
 End Function  
 Function secondarySVlookup(ByVal destflnm As String, ByVal primaryRG As String, ByVal secondaryRG As String, ByVal srcflnm As String) As String  
 Dim Rg As Range  
 'Set Detection range  
 Set Rg = Worksheets(srcflnm).Range("$A$2:$" & LastCol(srcflnm) & LastRow(srcflnm))  
 Dim RgPrimary As Range  
 'Set Primary Column Range  
 Set RgPrimary = Worksheets(destflnm).Range(primaryRG)  
 Dim RgSecondary As Range  
 'Set Secondary ID Range  
 Set RgSecondary = Worksheets(destflnm).Range(secondaryRG)  
 'set return string  
 Dim rtnstr As String  
 rtnstr = ""  
 'check each row in source worksheet  
 For q = 1 To LastRow(srcflnm) + 1  
 'if Primary Value and Secondary Value matched break  
 If (Rg(q, 1) = RgPrimary(1, 1) And Rg(q, 2) = RgSecondary(1, 1)) Then  
 'Put Value achived in return string  
 rtnstr = Rg(q, 3)  
 'break search  
 q = LastRow(srcflnm) + 1  
 End If  
 Next q  
 secondarySVlookup = rtnstr  
 End Function  
 Function LastRow(ByVal Filename As String) As Long  
 Dim ix As Long  
 ix = Worksheets(Filename).UsedRange.Row - 1 + Worksheets(Filename).UsedRange.Rows.Count  
 ' ix = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count  
 LastRow = ix  
 End Function  
 Function LastCol(ByVal Filename As String) As String  
 Dim ix As Integer  
 ix = Worksheets(Filename).UsedRange.Column - 1 + Worksheets(Filename).UsedRange.Columns.Count  
 LastCol = ConvertToLetter(ix)  
 End Function