Hi,

Based on the codes below, my intended result is to loop through under
the same workbook, within the worksheet array ( ie from visible sheetX
till end ) to copy range based on text string search( "*Total*" ) in
column A of visible sheets("X"), say text string found in A3 then will
copy range ("C3:H3") from sheets("X") and paste it to the last row
column B of visible sheets("X (2)") and so on until the last visible
sheet.
Only visible sheets within worksheet array will have duplicate sheets
denoted as "(2)" at the end of sheet name and total visible sheets at
least 2 and may be more which depends on the workbook available from
other source

After running the codes, the results fails to achieve the above
objective because the same worksheet copy back to the same worksheet
again

Set WB = Workbooks("ABC.xls")
With WB
NumShts = .Worksheets.Count
ReDim myArr(1 To NumShts)
For myCount = 1 To NumShts
ShtName = .Sheets(myCount).Name
If Worksheets(ShtName).Visible = True Then
If ShtName = ShtName1 Then
With Worksheets(ShtName)
iLoop = WorksheetFunction.CountIf(.Columns(1), "*Total*")
Set rNA = .Range("A1")
For u = 1 To iLoop
Set rNA = .Columns(1).Find(What:="*Total Operating
Expenses*", After:=rNA, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows,
_
SearchDirection:=xlNext, MatchCase:=True)
Worksheets(ShtName1).Select
Dim Ltrow As Long
Ltrow = Range("B" & Rows.Count).End(xlUp).Row + 1
rNA.Offset(0, 1).Resize(1, 5).Copy
Worksheets(ShtName1).Range("B" & Ltrow)
Next u
End With
End If
End If
Next myCount
End With

Any help will be much appreciated and thanks in advance


Regards
Len

On Jul 16, 2:21*am, Len wrote:
Hi,

Based on the codes below, my intended result is to loop through under
the same workbook, within the worksheet array ( ie from visible sheetX
till end ) to copy range based on text string search( "*Total*" ) in
column A of visible sheets("X"), say text string found in A3 then will
copy range ("C3:H3") from sheets("X") and paste it to the last row
column B of visible sheets("X (2)") *and so on until the last visible
sheet.
Only visible sheets within worksheet array will have duplicate sheets
denoted as "(2)" at the end of sheet name and total visible sheets at
least 2 and may be more which depends on the workbook available from
other source

After running the codes, the results fails to achieve the above
objective because the same worksheet copy back to the same worksheet
again

Set WB = Workbooks("ABC.xls")
With WB
* * NumShts = .Worksheets.Count
* * ReDim myArr(1 To NumShts)
* * For myCount = 1 To NumShts
* * ShtName = .Sheets(myCount).Name
* * If Worksheets(ShtName).Visible = True Then
* * If ShtName = ShtName1 Then
* * With Worksheets(ShtName)
* * iLoop = WorksheetFunction.CountIf(.Columns(1), "*Total*")
* * Set rNA = .Range("A1")
* * * For u = 1 To iLoop
* * * * *Set rNA = .Columns(1).Find(What:="*Total Operating
Expenses*", After:=rNA, _
* * * * * * *LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows,
_
* * * * * * *SearchDirection:=xlNext, MatchCase:=True)
* * Worksheets(ShtName1).Select
* * *Dim Ltrow As Long
* * *Ltrow = Range("B" & Rows.Count).End(xlUp).Row + 1
* * * rNA.Offset(0, 1).Resize(1, 5).Copy
Worksheets(ShtName1).Range("B" & Ltrow)
* * Next u
* * End With
* * End If
* * End If
* * Next myCount
* * End With

Any help will be much appreciated and thanks in advance

Regards
Len

"If desired, send your file to dguillett @gmail.com I will only look
if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results."

What I see happening is that your code copies from
'Worksheets(ShtName1)' and sets 'Worksheets(ShtName1)' as its
destination in the process.

If ShtName = ShtName1 Then...

Thus, your data should end up on the same sheet!

What I suggest is that you set absolute references to the source sheet
and the expected target sheet something like this:

Dim wksSource As Worksheet, wksTarget As Worksheet

Then, when you iterate the visible sheets:

If Not Right(ShtName, 3) = "(2)" Then
Set wksSource = Worksheets(ShtName)
ElseIf Right(ShtName, 3) = "(2)" Then
Set wksTarget = Worksheets(ShtName)
End If

Then process your loop something like:

With wksSource
'find your cells
Set rNA = 'code...

If Not rNA Is Nothing Then 'in case nothing found
Dim Ltrow As Long
With wksTarget
Ltrow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
End With
rNA.Offset(0, 1).Resize(1, 5).Copy wksTarget.Cells(Ltrow, 2)
End If
End With
Set rNA = Nothing 'reset variable

HTH

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Hi Garry,

Sorry for late reply due to our month end accounts closing
Thanks for your reply and your codes

After using your codes and tested, it works great !

Thanks & Regards
Len

Hi Don,

Thanks for your offer and now I found the solution, it works


Cheers
Len

Len wrote on 7/18/2010 :
Hi Garry,

Sorry for late reply due to our month end accounts closing
Thanks for your reply and your codes

After using your codes and tested, it works great !

Thanks & Regards
Len

You're welcome, ..glad I could help!

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc