?
Solved

Modifying a Recorded Macro

Posted on 2011-10-04
17
Medium Priority
?
253 Views
Last Modified: 2012-05-12
I recorded this macro and I would like to be able to run it on every worksheet in the workbook.

I tried adding for each workbook and next workbook to the macro I recorded, but it doesen't go to the next worksheet.

Also, at the end of the data is some "stuff" I would like to delete, but somehow doesn't seem to get recorded in my macro. Please see screen capture to see what I mean.


Here is what I have:

**************************************************************************
Sub FormatColoradoData()

Dim WS As Worksheet

For Each WS In ThisWorkbook.Worksheets

'START OF RECORDED MACRO

    Range("A5:A7").Select
    Selection.Copy
    Range("J5:J7").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("K5:K7").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J5:J7").Select
    ActiveCell.FormulaR1C1 = "WELLNAME"
    Range("K5:K7").Select
    ActiveCell.FormulaR1C1 = "WELLNO"
    Range("J8").Select
    ActiveCell.FormulaR1C1 = "=R1C1"
    Range("K8").Select
    ActiveCell.FormulaR1C1 = "=R2C2"
    Range("J8:K8").Select
    Selection.Copy
    Range("A8").Select
    Selection.End(xlDown).Select
    Range("J37:K37").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K8").Select

    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Rows("1:4").Select
    Selection.Delete Shift:=xlUp
    Range("A1:A3").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Rows("34:34").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("E1:G1").Select
    Selection.Delete Shift:=xlUp
    Range("E1:G2").Select
    Range("E3:G3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E1:G3").Select
    With Selection
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("H1:H3").Select
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("E1:H3").Select
    Selection.UnMerge
    Range("D1:D3").Select
    Selection.Copy
    Range("E1:E3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("F1:F3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("G1:G3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("F1:F3").Select
    ActiveCell.FormulaR1C1 = "CASING PSI"
    Range("G1:G3").Select
    ActiveCell.FormulaR1C1 = "LINE PSI"
    Range("F4").Select
   
   
   
    Range("G1:G3").Select
    Selection.Copy
    Range("H1:H3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("I1:I3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("J:J").EntireColumn.AutoFit
    Columns("K:K").ColumnWidth = 14.14
   
   

    Range("A4").Select
    Selection.End(xlDown).Select
    Rows("34:34").Select
    Range("B34").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("A1:A3").Select
   
  Next WS
 
End Sub
0
Comment
Question by:ktjamms2
  • 10
  • 7
17 Comments
 

Author Comment

by:ktjamms2
ID: 36912588
0
 
LVL 24

Expert Comment

by:StephenJR
ID: 36912615
Why attach a picture in a Word document? An Excel file would be much more helpful.
0
 
LVL 24

Expert Comment

by:StephenJR
ID: 36912623
Shortcut would be to add ws.activate after the For line.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:ktjamms2
ID: 36912686
0
 

Author Comment

by:ktjamms2
ID: 36912704
I'm trying to get the worksheets in the workbook formatted to import into a database table. The file I attached is just a sample, but the acutal file consists of about 50+ worksheets.
0
 
LVL 24

Accepted Solution

by:
StephenJR earned 2000 total points
ID: 36912723
You could use this, but you have to sort out those merged cells.
Sub FormatColoradoData()

Dim WS As Worksheet
Dim n As Long
For Each WS In ThisWorkbook.Worksheets
WS.Activate
'
' FormatColoradoData Macro
'

'
    Range("A5:A7").Select
    Selection.Copy
    Range("J5:J7").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("K5:K7").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J5:J7").Select
    ActiveCell.FormulaR1C1 = "WELLNAME"
    Range("K5:K7").Select
    ActiveCell.FormulaR1C1 = "WELLNO"
    Range("J8").Select
    ActiveCell.FormulaR1C1 = "=R1C1"
    Range("K8").Select
    ActiveCell.FormulaR1C1 = "=R2C2"
    Range("J8:K8").Select
    Selection.Copy
    Range("A8").Select
    Selection.End(xlDown).Select
    Range("J37:K37").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K8").Select

    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Rows("1:4").Select
    Selection.Delete Shift:=xlUp
    Range("A1:A3").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Rows("34:34").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("E1:G1").Select
    Selection.Delete Shift:=xlUp
    Range("E1:G2").Select
    Range("E3:G3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E1:G3").Select
    With Selection
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("H1:H3").Select
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("E1:H3").Select
    Selection.UnMerge
    Range("D1:D3").Select
    Selection.Copy
    Range("E1:E3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("F1:F3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("G1:G3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("F1:F3").Select
    ActiveCell.FormulaR1C1 = "CASING PSI"
    Range("G1:G3").Select
    ActiveCell.FormulaR1C1 = "LINE PSI"
    Range("F4").Select
    
    
    
    Range("G1:G3").Select
    Selection.Copy
    Range("H1:H3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("I1:I3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("J:J").EntireColumn.AutoFit
    Columns("K:K").ColumnWidth = 14.14
    
    

    Range("A4").Select
    Selection.End(xlDown).Select
    Rows("34:34").Select
    Range("B34").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("A1:A3").Select
    
    n = Range("A" & Rows.Count).End(xlUp).Row - 4
    Range("A" & n).Resize(4).EntireRow.Delete
    
  Next WS
 
End Sub

Open in new window

0
 

Author Comment

by:ktjamms2
ID: 36912834
How can I handle the merged cells. It triggers an alert that requires a click on OK? Also...I need to exclude the first worksheet because it has data that the other worksheets are using.
0
 
LVL 24

Expert Comment

by:StephenJR
ID: 36912862
Before you post a question why don't you take a few minutes to think about everything you need and set it out properly? By introducing new requests you are effectively devaluing my time because I have to go over old ground which I could have covered the first time.
0
 

Author Comment

by:ktjamms2
ID: 36912901
Really do apologize...The merged cells is a problem I figured I could live with if I had to, and overlooked the fact that the other sheets were using the first one until I saw the !ref errors after I ran the macro. Been a long day!
0
 
LVL 24

Expert Comment

by:StephenJR
ID: 36912918
Insert the name of the sheet to be excluded where indicated:
Sub FormatColoradoData()

Dim WS As Worksheet
Dim n As Long
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> "Name of first sheet here" Then
WS.Activate
Cells.UnMerge
'
' FormatColoradoData Macro
'

'
    Range("A5:A7").Select
    Selection.Copy
    Range("J5:J7").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("K5:K7").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J5:J7").Select
    ActiveCell.FormulaR1C1 = "WELLNAME"
    Range("K5:K7").Select
    ActiveCell.FormulaR1C1 = "WELLNO"
    Range("J8").Select
    ActiveCell.FormulaR1C1 = "=R1C1"
    Range("K8").Select
    ActiveCell.FormulaR1C1 = "=R2C2"
    Range("J8:K8").Select
    Selection.Copy
    Range("A8").Select
    Selection.End(xlDown).Select
    Range("J37:K37").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K8").Select

    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Rows("1:4").Select
    Selection.Delete Shift:=xlUp
    Range("A1:A3").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Rows("34:34").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("E1:G1").Select
    Selection.Delete Shift:=xlUp
    Range("E1:G2").Select
    Range("E3:G3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E1:G3").Select
    With Selection
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("H1:H3").Select
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("E1:H3").Select
    Selection.UnMerge
    Range("D1:D3").Select
    Selection.Copy
    Range("E1:E3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("F1:F3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("G1:G3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("F1:F3").Select
    ActiveCell.FormulaR1C1 = "CASING PSI"
    Range("G1:G3").Select
    ActiveCell.FormulaR1C1 = "LINE PSI"
    Range("F4").Select
    
    
    
    Range("G1:G3").Select
    Selection.Copy
    Range("H1:H3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("I1:I3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("J:J").EntireColumn.AutoFit
    Columns("K:K").ColumnWidth = 14.14
    
    

    Range("A4").Select
    Selection.End(xlDown).Select
    Rows("34:34").Select
    Range("B34").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("A1:A3").Select
    
    n = Range("A" & Rows.Count).End(xlUp).Row - 4
    Range("A" & n).Resize(4).EntireRow.Delete
End If
  Next WS
 
End Sub

Open in new window

0
 

Author Comment

by:ktjamms2
ID: 36913038
I tried your last post, but I got a runtime error "Method 'Range' of object '_Global' failed"

highlights on:
  Range("A" & n).Resize(4).EntireRow.Delete
0
 
LVL 24

Expert Comment

by:StephenJR
ID: 36913152
I tried the code on your sample and it worked for me.
0
 

Author Comment

by:ktjamms2
ID: 36916514
Sorry...my first sample didn't include the first page that the other sheets referance. Please try it with this sample.
Book1.xlsm
0
 

Author Comment

by:ktjamms2
ID: 36917261
It seems to be running the macro on Personal.xlsb....how do I fix that? I tried hiding it, but it still runs on it anyway.
0
 
LVL 24

Expert Comment

by:StephenJR
ID: 36917707
If I run the code I provided on that workbook it works, but I suggest you remove the lines which refer to merging cells.
0
 

Author Comment

by:ktjamms2
ID: 36917924
How can I store the macro in personal (so I can use it on multiple spreadsheets) and not have it run on the personal spreadsheet? That seems to be the problem with the error. If I put the macro in this worksheet, it runs fine. But, when it is stored in personal, it blows up.
0
 

Author Closing Comment

by:ktjamms2
ID: 36938677
Thank-you!
0

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question