Macro to Copy certain values from different sheets to TIME Sheet

[prkhan56]

Hello All,
I am using Office 2003.
I have a workbook with 30+ Worksheets plus a Worksheet named TIME.

For Example:
Sheet - TIME has name ABC, DEF, GHI (not necessary in this order) in
Column C7 downwards
Other Sheets name ABC, DEF, GHI ... ... (these names are only for
explanatory purposes)

I wish to have a macro which when run should do the following on the
Sheet named TIME.

Look Up the Value in Column C of Sheet named TIME and Copy the value
of J:43 of respective sheets in Column G and the value of L:43 of
respective sheets in Column H. i.e value of J:43 of ABC Sheet should
be copied to TIME sheet against ABC in Column G and value of L:43 of
ABC Sheet should be copied to TIME sheet against ABC in Column H... and
for the rest of the sheets.

I hope I am clear

Any help would be greatly appreciated.

TIA

Rashid Khan

 

[Tom Ogilvy]

Sub EFG()
Dim rng As Range, bReplace As Boolean
' this puts in formulas. If you want them
' replaced with the values they return, then
' set the value of bReplace to True

bReplace = False

With Worksheets("Time")
Set rng = Range("C7", Range("C7").End(xlDown))
End With

rng.Offset(0, 4).Formula = "=INDIRECT(""'""&C7&""'!J43"")"
rng.Offset(0, 5).Formula = "=INDIRECT(""'""&C7&""'!L43"")"

If bReplace Then
With rng.Offset(0, 4).Resize(, 2)
.Formula = .Value
End With
End If
End Sub

 

[prkhan56]

Thanks Tom,
You are a saviour. Works fine! But there is one small hitch.
There is a blank row which is C12. So the macro works fine from Row 7
to Row 11.

I modified the following line to overcome the Blank row and go right
down (Pardon my knowledge of VBA...I hope there is a better way)

Set rng = Range("C7", Range("C7").End(xlDown).End(xlDown).End(xlDown))

However, the above gives #REF! in Column G and H for the Blank Row
i.e. Row 12.

Can you fix this problem?

Thanks
Rashid Khan

 

[Tom Ogilvy]

First, I inadvertently omitted the periods inside the With statement in the
previous code (so it you use that, add them), so I have added them and
changed the sense of the statement to come up from the bottom. This should
overcome any blank cells being an impediment to processing the sheet names.

This assumes you want to included all the populated cells below row 6.

Second, I added a line to remove any formulas in cells returning an Error.

Sub EFG()
Dim rng As Range, bReplace As Boolean
' this puts in formulas. If you want them
' replaced with the values they return, then
' set the value of bReplace to True

bReplace = False

With Worksheets("Time")
Set rng = .Range("C7",.Cells(rows.count,"C").End(xlup))
End With

rng.Offset(0, 4).Formula = "=INDIRECT(""'""&C7&""'!J43"")"
rng.Offset(0, 5).Formula = "=INDIRECT(""'""&C7&""'!L43"")"
On Error Resume Next
rng.offset(0,4).Resize(,1).SpecialCells( _
xlFormulas,xlErrors).ClearContents
On Error goto 0
If bReplace Then
With rng.Offset(0, 4).Resize(, 2)
.Formula = .Value
End With
End If
End Sub

This code is untested so you might have to tweak it if there are any typos.

 

[prkhan56]

Hi Tom,
Thanks a million!
I just added the following to catch another error :

rng.Offset(0, 5).Resize(, 1).SpecialCells( _
xlFormulas, xlErrors).ClearContents

It works fine. Thanks once again.

Rashid Khan