check the vba code(Macro) in this file it works fine but what I want is to put the result only in sheet2 not in any other sheet or in new sheet

check the vba code(Macro) in this file it works fine but what I want is to put the result only in sheet2 not in any other sheet or in  new sheet
kindly see the attachment file
see the code below
Option Explicit

Sub Step4inSheet2()
Dim wSource As Worksheet, wTarg As Worksheet
Dim rSource As Range, rTarg As Range, rCell As Range
Dim iStart As Long, i As Long, iLast As Long
Dim highlight As Boolean, gap As Boolean

Set wSource = ActiveSheet
Set wTarg = ActiveWorkbook.Worksheets.Add

'create source range
Set rSource = wSource.Cells(1, 1).CurrentRegion
Set rSource = rSource.Resize(1, rSource.Columns.Count - 1).Offset(1, 0)
'target range:
Set rTarg = wTarg.Cells(1, 1)
    gap = False
    highlight = False
    'start at second cell in each row
    iStart = 2
    For i = 2 To rSource.Columns.Count
    'stop at blank cell:
    If rSource(i) = "" Then Exit For
        If rSource(i).Interior.Color <> RGB(255, 255, 255) Then
            If highlight Then
            'do nothing if cell is next to highlighted cell
            highlight = True
            'mark second highlighted cell
            If gap Then iStart = i
            End If
        If highlight Then gap = True
        highlight = False
        End If
'don't use iStart as first column if no data after it
iLast = i - 1
If iLast = iStart Then iStart = 2

'insert row title
rTarg = rSource(1)
Set rTarg = rTarg.Offset(0, 1)

'copy found data
For i = iStart To iLast
rTarg = rSource(i)
rTarg.Interior.Color = rSource(i).Interior.Color
Set rTarg = rTarg.Offset(0, 1)

'next source row
Set rSource = rSource.Offset(1, 0)
'next target row
Set rTarg = rTarg.Offset(1, 1 + (rTarg.Column * -1))
'stop at first blank row
Loop Until rSource(1) = ""

End Sub

Open in new window

Avinash SinghAsked:
Who is Participating?
Bill PrewCommented:
Change this line:

Set wTarg = ActiveWorkbook.Worksheets.Add

Open in new window


Set wTarg = ActiveWorkbook.Worksheets("Sheet2")

Open in new window

Fabrice LambertFabrice LambertCommented:
Or better, throw the "active" objects away as they're subject to change upon any interraction from the user, thus are unreliable:

Dim wb As Excel.workbook
Set wb = ThisWorkbook

Dim wSource As Excel.Worksheet
Set wSource = wb.Worksheets(1)    '// replace 1 by the name or position of your worksheet source

Dim wTarg As Excel.Worksheet
Set wTarg = wb.Worksheets(2)
Note: Indexing the worksheets collection by number will work whatever the worksheet name is.
But indexing by name will work whatever the worksheet's position is.
Your choice.
Avinash SinghAuthor Commented:
Thnx   Bill Prew Sir and Fabrice Lambert Sir for giving ur precious time to this post
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.