Loop within worksheet array

[Len]

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

 

[Don Guillett Excel MVP]

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."

 

[GS]

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

 

[Len]

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

 

[Len]

Hi Don,

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


Cheers
Len

 

[GS]

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!