Automate fill up the figure on 2 sheets from one sheet

[PRADEEPB270]

I am looking a VBA codes who helps me to insert the figures on my 2 sheets from one sheet at the time of changing the S.No.

Please refer my attach working file.In this file,whenever, I change the S.No.( Col.C on Sheets-HMSP and Others) then the figure ( Col.J on both sheets ) should be fill-up accoding to mention in the sheet 'Sheet1' .Means ,lookup the 'S.No.'from sheet 'HMSP' and 'Others' and match the 'S.No.'in sheet 'Sheet1',put up the figure ( Col.J ) from 'Sheet1' to both sheets.

[Rudi]

Hi Pradeep,

You do not need VBA for this. You can use a VLOOKUP function.
See the attached file for a demonstration.

Book1.xlsx

[PRADEEPB270]

But Rudi sir,I do not want to put an excel formula on my sheets.Request you to please provide the VBA Codes if easily possible.

[Rudi]

Will your workbook have more sheets that just HMSP and Other? In other words, does the macro need to insert the values in the J column of many more sheets like HMSP and Other, or is it just these two?

[PRADEEPB270]

Yes,I have 37 sheets in a workbook.Here is an example in brief and macro needs only in 'J'column of all the 37 sheets.

[Rudi]

Try this...

Code: Select all

Sub GetVals()
Dim rCalcT As Range, rCalcB As Range
Dim sh As Worksheet

'Change this to the name of the sheet containing the values in the 'J' column
Const shSource = "Sheet1"
'----------------------------------------------------------------------------
    Application.ScreenUpdating = False
    For Each sh In Worksheets
    If sh.Name = shSource Then GoTo Skip
    Set rCalcT = sh.Range("C4").Offset(1)
    Set rCalcB = sh.Range("C" & Rows.Count).End(xlUp)
        Range(rCalcT, rCalcB).Offset(0, 7).FormulaR1C1 = "=VLOOKUP(RC[-7]," & shSource & "!C1:C10,10,0)"
        Range(rCalcT, rCalcB).Offset(0, 7).Copy
        Range(rCalcT, rCalcB).Offset(0, 7).PasteSpecial xlPasteValuesAndNumberFormats
Skip:
    Next sh
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

[PRADEEPB270]

Macro is running perfect and Glad to find it.You are the GREAT Rudi sir.

[Rudi]

Sorry:
A fix again.... LOL, I always spot something I missed AFTER I post the code

Please change this line:

Code: Select all

        Range(rCalcT, rCalcB).Offset(0, 7).FormulaR1C1 = "=VLOOKUP(RC[-7],Sheet1!C1:C10,10,0)"

to this line:

Code: Select all

        Range(rCalcT, rCalcB).Offset(0, 7).FormulaR1C1 = "=VLOOKUP(RC[-7]," & shSource & "!C1:C10,10,0)"

[Rudi]

Glad it is working Pradeep.
Have a good day and weekend.