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