Run macro on selected sheets

T

terilad

Hi I have a workbook with 103 sheets, I want a macro to run on 100 of the
sheets.

Here is the macro, can anyone help me with this?

Sub ReconsileStockCard()
Range("D3").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Range("D3").Copy
Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Many thanks
 
D

Dave Peterson

Option Explicit
Sub ReconcileStockCard()

Dim wks As Worksheet

For Each wks In ActiveWorkbook.Worksheets
Select Case LCase(wks.Name)
'names of the sheets to skip
Case Is = "sheet9", "sheet13", "sheet33"
'do nothing
Case Else
With wks
.Range("D3").FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
.Range("D3").Copy
.Range("B7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Range("a7:a36,b8:b36,d3,d7:d36").ClearContents
End With
End Select
Next wks
End Sub

As an aside, this portion:

.Range("D3").Copy
.Range("B7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

could be replaced with:

.range("B7").value = .Range("D3").Value


Hi I have a workbook with 103 sheets, I want a macro to run on 100 of the
sheets.

Here is the macro, can anyone help me with this?

Sub ReconsileStockCard()
Range("D3").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Range("D3").Copy
Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Many thanks
Click to expand...
 
J

JLGWhiz

You can use an If ... Then statement to eliminate the three sheets you do
not want to run the macro on. The For ... Next statement will test each
sheet in the workbook.

Sub ReconsileStockCard()
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Sheet1" And sh.Name <> "Sheet2" And _
sh.Name <> "Sheet3" Then '<<<Sub actual sheet names
'Your code here
End If
Next
End Sub
 
R

Robert Flanagan

Try this:

Sub RunManyTimes()
Dim wS As Worksheet
For Each wS In ActiveWorkbook.Worksheets
If wS.Name = "sheet1" Or _
wS.Name = "some name" Or _
wS.Name = "some other name" Then
'do nothing
Else
wS.Select
ReconsileStockCard
End If
Next
End Sub

You can also clean up your code a bit by using

Range("D7:D36").ClearContents

Robert Flanagan
http://www.add-ins.com
Productivity add-ins and downloadable books on VB macros for Excel
 
M

Mike H

Hi,

Try this. I tided your code up a bit. Note this line

S = "Sheet1,Sheet2,Sheet3"

Are the 3 sheets you DON'T want the code to run on so change to suit


Sub ReconsileStockCard()
Dim Ws As Worksheet
S = "Sheet1,Sheet2,Sheet3"
V = Split(S, ",")
For Each Ws In ThisWorkbook.Worksheets
If IsError(Application.Match(Ws.Name, V, 0)) Then
Range("D3").FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Range("D3").Copy
Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7:D36").ClearContents
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.
 
M

Mike H

oops,

I need to qualify the ranges

Sub ReconsileStockCard()
Dim Ws As Worksheet
S = "Sheet1,Sheet2,Sheet3"
V = Split(S, ",")
For Each Ws In ThisWorkbook.Worksheets
If IsError(Application.Match(Ws.Name, V, 0)) Then
Ws.Range("D3").FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Ws.Range("D3").Copy
Ws.Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Ws.Range("A7:A36,B8:B36").ClearContents
Ws.Range("D3").ClearContents
Ws.Range("D7:D36").ClearContents
' Range("A1:D2").Select
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


Mike H said:
Hi,

Try this. I tided your code up a bit. Note this line

S = "Sheet1,Sheet2,Sheet3"

Are the 3 sheets you DON'T want the code to run on so change to suit


Sub ReconsileStockCard()
Dim Ws As Worksheet
S = "Sheet1,Sheet2,Sheet3"
V = Split(S, ",")
For Each Ws In ThisWorkbook.Worksheets
If IsError(Application.Match(Ws.Name, V, 0)) Then
Range("D3").FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Range("D3").Copy
Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7:D36").ClearContents
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


terilad said:
Hi I have a workbook with 103 sheets, I want a macro to run on 100 of the
sheets.

Here is the macro, can anyone help me with this?

Sub ReconsileStockCard()
Range("D3").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Range("D3").Copy
Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Many thanks
Click to expand...
Click to expand...
 
T

terilad

Hi Mike,

This doesn't seem to work for me, it is running the code on the worksheet I
have a link to run the macro even although I state the sheet not to run the
macro, any ideas, also I have a new code, I input the wrong one the last time.

New Code

Sub ReconsileStockCard()
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Regards

Mark

Mike H said:
Hi,

Try this. I tided your code up a bit. Note this line

S = "Sheet1,Sheet2,Sheet3"

Are the 3 sheets you DON'T want the code to run on so change to suit


Sub ReconsileStockCard()
Dim Ws As Worksheet
S = "Sheet1,Sheet2,Sheet3"
V = Split(S, ",")
For Each Ws In ThisWorkbook.Worksheets
If IsError(Application.Match(Ws.Name, V, 0)) Then
Range("D3").FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Range("D3").Copy
Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7:D36").ClearContents
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


terilad said:
Hi I have a workbook with 103 sheets, I want a macro to run on 100 of the
sheets.

Here is the macro, can anyone help me with this?

Sub ReconsileStockCard()
Range("D3").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Range("D3").Copy
Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Many thanks
Click to expand...
Click to expand...
 
M

Mike H

While the revised version of my code will do what you want dave peterson has
a better solution, use that
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


terilad said:
Hi Mike,

This doesn't seem to work for me, it is running the code on the worksheet I
have a link to run the macro even although I state the sheet not to run the
macro, any ideas, also I have a new code, I input the wrong one the last time.

New Code

Sub ReconsileStockCard()
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Regards

Mark

Mike H said:
Hi,

Try this. I tided your code up a bit. Note this line

S = "Sheet1,Sheet2,Sheet3"

Are the 3 sheets you DON'T want the code to run on so change to suit


Sub ReconsileStockCard()
Dim Ws As Worksheet
S = "Sheet1,Sheet2,Sheet3"
V = Split(S, ",")
For Each Ws In ThisWorkbook.Worksheets
If IsError(Application.Match(Ws.Name, V, 0)) Then
Range("D3").FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Range("D3").Copy
Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7:D36").ClearContents
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


terilad said:
Hi I have a workbook with 103 sheets, I want a macro to run on 100 of the
sheets.

Here is the macro, can anyone help me with this?

Sub ReconsileStockCard()
Range("D3").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Range("D3").Copy
Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Many thanks
Click to expand...
Click to expand...
Click to expand...
 
T

terilad

Hi Mike,

None of them working maybe because I changed my original code.

What do you think, my new code.

Sub ClearStockCard()
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Many thanks

Mark

Mike H said:
While the revised version of my code will do what you want dave peterson has
a better solution, use that
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


terilad said:
Hi Mike,

This doesn't seem to work for me, it is running the code on the worksheet I
have a link to run the macro even although I state the sheet not to run the
macro, any ideas, also I have a new code, I input the wrong one the last time.

New Code

Sub ReconsileStockCard()
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Regards

Mark

Mike H said:
Hi,

Try this. I tided your code up a bit. Note this line

S = "Sheet1,Sheet2,Sheet3"

Are the 3 sheets you DON'T want the code to run on so change to suit


Sub ReconsileStockCard()
Dim Ws As Worksheet
S = "Sheet1,Sheet2,Sheet3"
V = Split(S, ",")
For Each Ws In ThisWorkbook.Worksheets
If IsError(Application.Match(Ws.Name, V, 0)) Then
Range("D3").FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Range("D3").Copy
Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7:D36").ClearContents
End If
Next
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


:

Hi I have a workbook with 103 sheets, I want a macro to run on 100 of the
sheets.

Here is the macro, can anyone help me with this?

Sub ReconsileStockCard()
Range("D3").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Range("D3").Copy
Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Many thanks
Click to expand...
Click to expand...
Click to expand...
 
T

terilad

Hi Dave

This doesn't work for me maybe because I changed my code, my new code is.

Sub ClearStockCard()
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Regards

Mark

Dave Peterson said:
Option Explicit
Sub ReconcileStockCard()

Dim wks As Worksheet

For Each wks In ActiveWorkbook.Worksheets
Select Case LCase(wks.Name)
'names of the sheets to skip
Case Is = "sheet9", "sheet13", "sheet33"
'do nothing
Case Else
With wks
.Range("D3").FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
.Range("D3").Copy
.Range("B7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Range("a7:a36,b8:b36,d3,d7:d36").ClearContents
End With
End Select
Next wks
End Sub

As an aside, this portion:

.Range("D3").Copy
.Range("B7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

could be replaced with:

.range("B7").value = .Range("D3").Value


Hi I have a workbook with 103 sheets, I want a macro to run on 100 of the
sheets.

Here is the macro, can anyone help me with this?

Sub ReconsileStockCard()
Range("D3").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Range("D3").Copy
Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Many thanks
Click to expand...
Click to expand...
 
D

Dave Peterson

I don't see how that can loop through each of the sheets.

Did you try that suggested code?
Hi Dave

This doesn't work for me maybe because I changed my code, my new code is.

Sub ClearStockCard()
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Regards

Mark

Dave Peterson said:
Option Explicit
Sub ReconcileStockCard()

Dim wks As Worksheet

For Each wks In ActiveWorkbook.Worksheets
Select Case LCase(wks.Name)
'names of the sheets to skip
Case Is = "sheet9", "sheet13", "sheet33"
'do nothing
Case Else
With wks
.Range("D3").FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
.Range("D3").Copy
.Range("B7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Range("a7:a36,b8:b36,d3,d7:d36").ClearContents
End With
End Select
Next wks
End Sub

As an aside, this portion:

.Range("D3").Copy
.Range("B7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

could be replaced with:

.range("B7").value = .Range("D3").Value


Hi I have a workbook with 103 sheets, I want a macro to run on 100 of the
sheets.

Here is the macro, can anyone help me with this?

Sub ReconsileStockCard()
Range("D3").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4]C[-2]:R[97]C[-2])"
Range("D3").Copy
Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7:A36,B8:B36").ClearContents
Range("D3").ClearContents
Range("D7").ClearContents
Range("D8").ClearContents
Range("D9").ClearContents
Range("D10").ClearContents
Range("D11").ClearContents
Range("D12").ClearContents
Range("D13").ClearContents
Range("D14").ClearContents
Range("D15").ClearContents
Range("D16").ClearContents
Range("D17").ClearContents
Range("D18").ClearContents
Range("D19").ClearContents
Range("D20").ClearContents
Range("D21").ClearContents
Range("D22").ClearContents
Range("D23").ClearContents
Range("D24").ClearContents
Range("D25").ClearContents
Range("D26").ClearContents
Range("D27").ClearContents
Range("D28").ClearContents
Range("D29").ClearContents
Range("D30").ClearContents
Range("D31").ClearContents
Range("D32").ClearContents
Range("D33").ClearContents
Range("D34").ClearContents
Range("D35").ClearContents
Range("D36").ClearContents
Range("A1:D2").Select
End Sub

Many thanks
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Help 3
Save as 13
Macro to run on selected sheets 18
Clear contents on specified ranges 3
Weird Macro Problem 6
Error Message: "Can't Execute Code in Break Mode" 6
VBA Error Message HELP!!!!! 0
Linking Cells Macro 3

Top