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)
Do
    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
            Else
            highlight = True
            'mark second highlighted cell
            If gap Then iStart = i
            End If
        Else
        If highlight Then gap = True
        highlight = False
        End If
    Next
'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

'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

Sample123--2-.xlsm
Avinash SinghAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Bill PrewIT / Software Engineering ConsultantCommented:
Change this line:

Set wTarg = ActiveWorkbook.Worksheets.Add

Open in new window

To:

Set wTarg = ActiveWorkbook.Worksheets("Sheet2")

Open in new window


»bp
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
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.
0
Avinash SinghAuthor Commented:
Thnx   Bill Prew Sir and Fabrice Lambert Sir for giving ur precious time to this post
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.