VBA Code Collection

gistfile1.txt

VBA Code:
Instruction: 
Step-1: alt+F11
Step-2: Insert>Module
Step-3: Input/Write the Code
Step-4: Click Run Sub/UserForm (F5)
-----------------------------------
1. Rename Sheet basis of row or column name

Sub RenameSheet()

Dim rs As Worksheet

For Each rs In Sheets
rs.Name = rs.Range("B2")
Next rs

End Sub

-------------------------
2. Delete same rows across multiple sheets In Excel

Sub bleh()
    Dim xWs As Worksheet
    Set xWs = ActiveSheet
    ThisWorkbook.Worksheets.Select
    Rows("10:20").Select
    Selection.Delete
    xWs.Select
End Sub

----------------------------
3. Excel Sorting (Ascending-Descending)

==========================
--------Ascending---------
==========================
Sub SortSheets1()
    Dim I As Integer
    Dim J As Integer

    For I = 1 To Sheets.Count - 1
        For J = I + 1 To Sheets.Count
            If UCase(Sheets(I).Name) > UCase(Sheets(J).Name) Then
                Sheets(J).Move Before:=Sheets(I)
            End If
        Next J
    Next I
End Sub


==========================
--------Descending---------
==========================
Sub SortSheets1()
    Dim I As Integer
    Dim J As Integer

    For I = 1 To Sheets.Count - 1
        For J = I + 1 To Sheets.Count
            If UCase(Sheets(I).Name) < UCase(Sheets(J).Name) Then
                Sheets(J).Move Before:=Sheets(I)
            End If
        Next J
    Next I
End Sub

------------------------------------------
4. Combine Multiple Excel Spreadsheet into One Excel File

Sub GetSheets()
'Update ExcelJunction.com
Path = ""
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

For Video tutorial: https://www.youtube.com/watch?v=JiAYngRcN0s

---------------------------------------
5. Making Multiple Worksheet Copies

Sub SimpleCopy1()
    Do While Sheets.Count < 20
        ActiveSheet.Copy After:=Sheets(Sheets.Count)
    Loop
End Sub

----------------------------------------
6. Combine Sheet Into One Master Sheet

Sub AppendAllSheetsData()
  'Made it easy by ExcelExciting.com
    Dim i As Integer
    On Error Resume Next
    'Create New Sheet called as MergedSheet
    Sheets(1).Select
    Worksheets.Add
    'You can rename the sheet name here
    Sheets(1).Name = "MergedSheet"
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")
    'Loop Start Here to combine the sheets
    For i = 2 To Sheets.Count
        Sheets(i).Activate
        Range("A1").Select
        Selection.CurrentRegion.Select
        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
        Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
    Next i
    Sheets(1).Activate
End Sub

Video Tutorial: https://www.youtube.com/watch?v=sIxZP3aRyU8

--------------------------------
7. Scroll all worksheets to top


Sub Select_A1_On_Activeworkbook()
    Dim xSheet As Worksheet
    For Each xSheet In ActiveWorkbook.Sheets
        xSheet.Activate
        ActiveSheet.Range("C2").Select
    Next
    ActiveWorkbook.Worksheets(1).Activate
End Sub
--------------------------------
8. Freeze Panes for multiple sheets at once

Sub Test()
    Dim Sh As Worksheet
    Application.ScreenUpdating = False
    For Each Sh In ThisWorkbook.Worksheets
        With Sh
            .Activate
            .Range("A1").Activate
            .Range("C2").Activate
        End With
        ActiveWindow.FreezePanes = True
    Next Sh
    ThisWorkbook.Worksheets(1).Activate
    Application.ScreenUpdating = False
End Sub

-------------------
9. Duplicate Sheet in Excel:

Sub DuplicateSheet()
Dim x As Integer
x = InputBox("Enter number of times to copy the Active Sheet")
For numtimes = 1 To x
ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
Next
End Sub
----------------------