Modifying a Recorded Macro

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
ktjamms2Asked:
Who is Participating?
 
StephenJRCommented:
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
 
ktjamms2Author Commented:
0
 
StephenJRCommented:
Why attach a picture in a Word document? An Excel file would be much more helpful.
0
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

 
StephenJRCommented:
Shortcut would be to add ws.activate after the For line.
0
 
ktjamms2Author Commented:
0
 
ktjamms2Author Commented:
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
 
ktjamms2Author Commented:
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
 
StephenJRCommented:
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
 
ktjamms2Author Commented:
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
 
StephenJRCommented:
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
 
ktjamms2Author Commented:
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
 
StephenJRCommented:
I tried the code on your sample and it worked for me.
0
 
ktjamms2Author Commented:
Sorry...my first sample didn't include the first page that the other sheets referance. Please try it with this sample.
Book1.xlsm
0
 
ktjamms2Author Commented:
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
 
StephenJRCommented:
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
 
ktjamms2Author Commented:
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
 
ktjamms2Author Commented:
Thank-you!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.