# Loop though workbook and insert a function in each worksheet

#### Bamerand

##### Board Regular
Hi there,

Can anybody assist me with the following? I need to re-develop a macro that enters a formula into each worksheet within a workbook. The workbook has 25 worksheet and I need to insert a formulat that divided the last reading in the columns "C", "G", "E" and "I". Here is what I was able to come with:

Sub Test()
Dim rng As Range

Set rngC = Range("C" & Cells(Rows.Count, "C").End(xlUp).Row)
Set rngE = Range("E" & Cells(Rows.Count, "E").End(xlUp).Row)
Set rngG = Range("G" & Cells(Rows.Count, "G").End(xlUp).Row)
Set rngI = Range("I" & Cells(Rows.Count, "I").End(xlUp).Row)

rngC.Offset(1, 0).Value = rngC / 14.5
rngE.Offset(1, 0).Value = rngE / 14.5
rngG.Offset(1, 0).Value = rngG / 14.5
rngI.Offset(1, 0).Value = rngI / 14.5

End Sub

When I run the code, it work perfectely and inserts the formula into desired destination (divides last value in any of the columns "C", "G", "E" and "I"). But, what I can not do is make code loop so that the macro is applied for the entire workbook and spares me from running the-present code at each worksheet individually. I tried this code:

Sub LoopTest()
Dim Current As Worksheet
For Each Current In Worksheets
' here i pasted the macro "Test"
Next
End Sub

But it did not work. Can anybody give a hint on how should I make it run as it should?

### Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Hi

Try this

Code:
``````Sub Test()

Dim sht As Worksheet

For Each sht In ThisWorkbook.Sheets

With sht
.Activate
Set rngC = .Range("C" & Cells(Rows.Count, "C").End(xlUp).Row)
Set rngE = .Range("E" & Cells(Rows.Count, "E").End(xlUp).Row)
Set rngG = .Range("G" & Cells(Rows.Count, "G").End(xlUp).Row)
Set rngI = .Range("I" & Cells(Rows.Count, "I").End(xlUp).Row)

rngC.Offset(1, 0).Value = rngC / 14.5
rngE.Offset(1, 0).Value = rngE / 14.5
rngG.Offset(1, 0).Value = rngG / 14.5
rngI.Offset(1, 0).Value = rngI / 14.5
End With

Next sht
End Sub``````

That seems to be quite an inefficient way of writing values to cells. I'd go with the below (untested) code...

Code:
``````Sub Test()
Dim ws As Worksheet
Dim i As Long

Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets
For i = 3 To 9 Step 2
With ws.Cells(Rows.Count, i).End(xlUp)
.Offset(1) = .Value / 14.5
End With
Next i
Next ws

Application.ScreenUpdating = True

End Sub``````

try below
Code:
``````Sub Test()
Dim my As Integer
Sheets(1).Select
my = ThisWorkbook.Worksheets.Count
Do Until ActiveSheet.name = my
Set rngC = Range("C" & Cells(Rows.Count, "C").End(xlUp).Row)
Set rngE = Range("E" & Cells(Rows.Count, "E").End(xlUp).Row)
Set rngG = Range("G" & Cells(Rows.Count, "G").End(xlUp).Row)
Set rngI = Range("I" & Cells(Rows.Count, "I").End(xlUp).Row)
rngC.Offset(1, 0).Value = rngC / 14.5
rngE.Offset(1, 0).Value = rngE / 14.5
rngG.Offset(1, 0).Value = rngG / 14.5
rngI.Offset(1, 0).Value = rngI / 14.5
On Error GoTo GetLost
ActiveSheet.Next.Select
Loop
GetLost:
End Sub``````

Dear all,

All three options worked out in perfect. Saves me from burden of work. Is there a chance to amend the code to a way so that the final results are copied and pasted into a seperate sheet? I need to have it the data from all 25 worksheets merged into a single worksheet.

Thanks a lot in advance and regards.

try below code
Code:
``````Sub Test()
Dim my As Integer
Sheets(1).Select
my = ThisWorkbook.Worksheets.Count
Do Until ActiveSheet.Name = my
Set rngC = Range("C" & Cells(Rows.Count, "C").End(xlUp).Row)
Set rngE = Range("E" & Cells(Rows.Count, "E").End(xlUp).Row)
Set rngG = Range("G" & Cells(Rows.Count, "G").End(xlUp).Row)
Set rngI = Range("I" & Cells(Rows.Count, "I").End(xlUp).Row)
rngC.Offset(1, 0).Value = rngC / 14.5
rngE.Offset(1, 0).Value = rngE / 14.5
rngG.Offset(1, 0).Value = rngG / 14.5
rngI.Offset(1, 0).Value = rngI / 14.5
On Error GoTo GetLost
ActiveSheet.Next.Select
Loop
GetLost:
Dim ws As Worksheet
Sheets(1).Select
For Each ws In ThisWorkbook.Worksheets
With ws
.Range("C" & Rows.Count).End(xlUp).Copy Sheets("Result").Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
.Range("E" & Rows.Count).End(xlUp).Copy Sheets("Result").Range("E" & Rows.Count).End(xlUp).Offset(1, 0)
.Range("G" & Rows.Count).End(xlUp).Copy Sheets("Result").Range("G" & Rows.Count).End(xlUp).Offset(1, 0)
.Range("I" & Rows.Count).End(xlUp).Copy Sheets("Result").Range("I" & Rows.Count).End(xlUp).Offset(1, 0)
End With
Next ws
End Sub``````

Dear kevatarvind,

Thanks for the code, but, no, it did not work. It pasted four "0" in the columns corresponding in "C", "E", "G" and "I". Any clues if this can be changed?

Dear kevatarvind,

Thanks for the code, but, no, it did not work. It pasted four "0" in the columns corresponding in "C", "E", "G" and "I". Any clues if this can be changed?

dear kevatarvind,

thanks for the code, but, no, it did not work. It pasted four "0" in the columns corresponding in "c", "e", "g" and "i". Any clues if this can be changed?

can you upload your sample file in any sharing site and paste the link here pls it would be easy for me ?

BCOZ THE SAME CODE WORKING IN MY FILE

Send me your email. I can not upload the file. Maybe I can send by email, if this is fine with you.

Replies
4
Views
130
Replies
2
Views
151
Replies
3
Views
215
Replies
5
Views
165
Replies
7
Views
291

### Forum statistics

1,196,487
Messages
6,015,500
Members
441,898
Latest member
kofafa ### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?    1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option. Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com". Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button. Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button. Go back