Scribd
Upload
9 views

Create Ro Sheets

The provided VBA code creates individual worksheets for each unique RO name found in the first column of 'Sheet1'. It checks for existing sheets, creates new ones if necessary, and copies relevant data filtered by RO name into the respective sheets. The process runs efficiently with screen updating turned off and concludes by notifying the user of successful creation.

Uploaded by

Ramesh Chintala
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
9 views

Create Ro Sheets

The provided VBA code creates individual worksheets for each unique RO name found in the first column of 'Sheet1'. It checks for existing sheets, creates new ones if necessary, and copies relevant data filtered by RO name into the respective sheets. The process runs efficiently with screen updating turned off and concludes by notifying the user of successful creation.

Uploaded by

Ramesh Chintala
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
You are on page 1/ 2

Sub CreateROSheets()

Dim wsData As Worksheet, wsRO As Worksheet

Dim lastRow As Long, lastCol As Long

Dim roName As String

Dim i As Long

' Set the data sheet (change "Sheet1" if needed)

Set wsData = ThisWorkbook.Worksheets("Sheet1")

' Find the last row and column of the data

lastRow = wsData.Cells(Rows.Count, "A").End(xlUp).Row

lastCol = wsData.Cells(1, Columns.Count).End(xlToLeft).Column

' Turn off screen updating for faster execution

Application.ScreenUpdating = False

' Loop through each row in the RO column (starting from row 2 to skip headers)

For i = 2 To lastRow

roName = wsData.Cells(i, "A").Value ' Get the RO name

' Check if a sheet with this RO name already exists

On Error Resume Next ' Handle potential error if sheet doesn't exist

Set wsRO = ThisWorkbook.Worksheets(roName)

On Error GoTo 0 ' Reset error handling

' If the sheet doesn't exist, create it

If wsRO Is Nothing Then

Set wsRO =
ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count
))
wsRO.Name = roName

' Copy headers to the new sheet

wsData.Rows(1).Copy Destination:=wsRO.Rows(1)

End If

' Clear existing data below headers in the RO sheet (if any)

wsRO.Rows("2:" & wsRO.Cells(Rows.Count, "A").End(xlUp).Row).ClearContents

' Filter the data based on RO name and copy to the RO sheet

wsData.Range("A1:A" & lastRow).AutoFilter Field:=1, Criteria1:=roName

wsData.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy


Destination:=wsRO.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

wsData.AutoFilterMode = False ' Turn off filter

Set wsRO = Nothing ' Reset the worksheet variable

Next i

' Turn screen updating back on

Application.ScreenUpdating = True

MsgBox "RO sheets created successfully!", vbInformation

End Sub

You might also like