How to perform action in all worksheets

[Sethaholic]

Hi,

I'm relatively new to vba and have been struggling to perform a macr
that looks through all worksheets instead of a specific worksheet (i.
"Leon" or "Lee") I indicate. What I am trying to do here is to matc
account numbers in one workbook with account numbers in anothe
workbook ("text"). If they match, then I want it to copy specifi
columns from one to another. The code works, but I can only get it t
do it for each specific worksheet, meaning that I would have to chang
it from "Leon" to "Lee" if I want it to perform the macro for "Lee."
tried using the "For each sh in thisworkbook.worksheets" but don't kno
where to go from there. Please help. Here's my code so far. Thanks i
advance!

Sub ExtractData()

Dim intRec As Integer, rngData As Range, rngItem As Range, rngCom
As Range, rngOut As Range

Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Leon")
Set rngData = .Range("C33:C"
.Range("C60").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
End With
With Workbooks("text").Worksheets("sheet1")
Set rngComb = .Range("A1:A" & .Range("A65536").End(xlUp).Row)

End With

For Each rngItem In rngComb
If rngItem = "stop" Then Exit Sub
Set rngOut = rngData.Find(What:=rngItem)

If Not rngOut Is Nothing Then
rngOut.Offset(0, 2).Value = rngItem.Offset(0, 4).Value
rngOut.Offset(0, 3).Value = rngItem.Offset(0, 5).Value
rngOut.Offset(0, 4).Value = rngItem.Offset(0, 6).Value
rngOut.Offset(0, 5).Value = rngItem.Offset(0, 7).Value
Else
End If
Next rngItem

Application.ScreenUpdating = True

End Su

 

[Bernie Deitrick]

For Each mysht In ThisWorkbook.Worksheets
With mysht
Set rngData = .Range("C33:C" & Range("C60").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
<snipped you other code>
Next rngItem
Next mysht


HTH,
Bernie
MS Excel MVP

 

[Bernie Deitrick]

Noticed an error that I overlooked:

Set rngData = .Range("C33:C" & Range("C60").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
should be
Set rngData = .Range("C33:C" & .Range("C60").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
or, more simply

Set rngData = .Range("C33", Range("C60").End(xlUp)).SpecialCells(xlCellTypeConstants)

--
HTH,
Bernie
MS Excel MVP

For Each mysht In ThisWorkbook.Worksheets
With mysht
Set rngData = .Range("C33:C" & Range("C60").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
<snipped you other code>
Next rngItem
Next mysht


HTH,
Bernie
MS Excel MVP

 

[Bernie Deitrick]

I'll get the whole thing right eventually: ;-)

or, more simply

Set rngData = .Range("C33", .Range("C60").End(xlUp)).SpecialCells(xlCellTypeConstants)


--
HTH,
Bernie
MS Excel MVP

Noticed an error that I overlooked:

Set rngData = .Range("C33:C" & Range("C60").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
should be
Set rngData = .Range("C33:C" & .Range("C60").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
or, more simply

Set rngData = .Range("C33", Range("C60").End(xlUp)).SpecialCells(xlCellTypeConstants)

 

[Sethaholic]

I did as you told, and when I run the macro, it pauses for a while, and
it seems to work. But then I check the numbers and they are not right.
It seems as if nothing happened even. Do you think I'm missing
something? Here's my new code:

Sub ExtractData()

Dim intRec As Integer, rngData As Range, rngItem As Range, rngComb
As Range, rngOut As Range
Dim mysht As Worksheet

Application.ScreenUpdating = False

For Each mysht In ThisWorkbook.Worksheets
With mysht
Set rngData = Range("C33:C" &
Range("C60").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
End With

With Workbooks("text").Worksheets("sheet1")
Set rngComb = Range("A1:A" & .Range("A65536").End(xlUp).Row)

End With

For Each rngItem In rngComb
If rngItem = "stop" Then Exit Sub
Set rngOut = rngData.Find(What:=rngItem)

If Not rngOut Is Nothing Then
rngOut.Offset(0, 2).Value = rngItem.Offset(0, 4).Value
rngOut.Offset(0, 3).Value = rngItem.Offset(0, 5).Value
rngOut.Offset(0, 4).Value = rngItem.Offset(0, 6).Value
rngOut.Offset(0, 5).Value = rngItem.Offset(0, 7).Value
Else
End If
Next rngItem
Next mysht
Application.ScreenUpdating = True

End Sub



thanks in advance!

 

[Sethaholic]

I added your new changes. It still doesn't work. This stuff is s
frustrating...am I missing a loop or something?


Sub ExtractData()

Dim intRec As Integer, rngData As Range, rngItem As Range, rngCom
As Range, rngOut As Range
Dim mysht As Worksheet

Application.ScreenUpdating = False

For Each mysht In ThisWorkbook.Worksheets
With mysht
Set rngData = .Range("C33"
.Range("C60").End(xlUp)).SpecialCells(xlCellTypeConstants)
End With

With Workbooks("text").Worksheets("sheet1")
Set rngComb = Range("A1:A" & .Range("A65536").End(xlUp).Row)

End With

For Each rngItem In rngComb
If rngItem = "stop" Then Exit Sub
Set rngOut = rngData.Find(What:=rngItem)

If Not rngOut Is Nothing Then
rngOut.Offset(0, 2).Value = rngItem.Offset(0, 4).Value
rngOut.Offset(0, 3).Value = rngItem.Offset(0, 5).Value
rngOut.Offset(0, 4).Value = rngItem.Offset(0, 6).Value
rngOut.Offset(0, 5).Value = rngItem.Offset(0, 7).Value
Else
End If
Next rngItem
Next mysht
Application.ScreenUpdating = True

End Su

 

[Sethaholic]

nevermind, i got it!! woohooo!!

THANKS BERNIE!! I AM VERY GRATEFUL!!