Actually this code is for my own reference as a template for future to make my life easier because many people ask me to create summary sheet after processing certain sheets. For example we need to extract or sort specific data from current sheet and place sorted data at new summary sheet.
Option Explicit Sub CreateSummaryList() Dim IntSht As Integer Dim ShtSummary As Worksheet Dim ShtActive As Worksheet Dim LngRow As Long, LngLstRow As Long Dim i As Integer 'To check either user work with summary sheet or not? Yes then exit If UCase(ActiveSheet.Name) = "SUMMARY" Then MsgBox "Sorry! You are trying to work with summary sheet." Exit Sub 'To check active sheet empty or not? Empty then exit ElseIf WorksheetFunction.CountA(Cells) = 0 Then MsgBox "Sorry! Active Sheet is empty." Exit Sub End If i = 1 'Starting Row for summary Set ShtActive = ActiveSheet 'Current sheet 'To check existance of summary sheet and delete For IntSht = Sheets.Count To 1 Step -1 If Sheets(IntSht).Name = "Summary" Then Application.DisplayAlerts = False Sheets(IntSht).Delete Application.DisplayAlerts = True End If Next 'To create new summary sheet Set ShtSummary = Sheets.Add(After:=ActiveWorkbook.Sheets(Sheets.Count)) ShtSummary.Name = "Summary" 'To work with active sheet and place new data into summary ShtActive.Activate LngLstRow = ShtActive.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row For LngRow = 1 To LngLstRow If ShtActive.Range("A" & LngRow) <> "" Then ShtSummary.Range("A" & i) = ShtActive.Range("A" & LngRow) 'More code goes here i = i + 1 End If Next 'To work with Summary sheet ShtSummary.Activate LngLstRow = ShtSummary.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row For LngRow = 1 To LngLstRow If ShtSummary.Range("A" & LngRow) <> "" Then 'Your code goes here End If Next Range("A1").Select End Sub
The above code will: