Run macro in whole workbook

DOF2001

Active Member
Joined
Jan 28, 2005
Messages
310
HI! to all

I have this macro that runs great but i want to make it work in the whole workbook besides the first 2 sheets, does any one has a quic solution for this, i will appreciate.


Thanks!

Sub Curves_Transpose_Part1()

Rows("1:1").Select
Selection.Insert Shift:=xlDown

Dim a1 As Range, rng0
Set rng0 = Range("Q1:CE1")
For Each a1 In rng0
If a1.Offset(1, 0) > " " Then
a1.FormulaR1C1 = "=R[1]C[1]-R[1]C-1"
End If
Next a1

Dim c As Range, Rng
Set Rng = Range("Q1:CE1")

For Each c In Rng
Select Case c
Case Is = 1:
c.Offset(0, 1).EntireColumn.Insert Shift:=xlToRight
c.Offset(1, 1).FormulaR1C1 = "a"
Case Is = 2:
c.Offset(0, 1).EntireColumn.Insert Shift:=xlToRight
c.Offset(0, 1).EntireColumn.Insert Shift:=xlToRight
c.Offset(1, 1).FormulaR1C1 = "b"
c.Offset(1, 2).FormulaR1C1 = "b"

End Select
Next c
Rows("1:1").Select
Selection.Delete Shift:=xlUp

End Sub
 

Some videos you may like

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,913
Office Version
  1. 365
Platform
  1. Windows
Do you mean run the same code on each worksheet?
Code:
Sub Curves_Transpose_Part1()

Dim ws As Worksheet
Dim a1 As Range, rng0 As Range
Dim c As Range, Rng As Range

    For Each ws In Worksheets
        With ws
            .Rows("1:1").Insert Shift:=xlDown
            Set rng0 = .Range("Q1:CE1")
            For Each a1 In rng0
                If a1.Offset(1, 0) > " " Then
                    a1.FormulaR1C1 = "=R[1]C[1]-R[1]C-1"
                End If
            Next a1
    
            Set Rng = .Range("Q1:CE1")
    
            For Each c In Rng
                Select Case c
                    Case Is = 1:
                        c.Offset(0, 1).EntireColumn.Insert Shift:=xlToRight
                        c.Offset(1, 1) = "a"
                    Case Is = 2:
                        c.Offset(0, 1).EntireColumn.Insert Shift:=xlToRight
                        c.Offset(0, 1).EntireColumn.Insert Shift:=xlToRight
                        c.Offset(1, 1) = "b"
                        c.Offset(1, 2) = "b"
                End Select
            Next c
            .Rows("1:1").Delete Shift:=xlUp
        End With
    Next ws
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,113,846
Messages
5,544,630
Members
410,626
Latest member
rkmadasu
Top