Creating a macro that will copy down content from certain cells

[UTdawg]

Hi all,

I've created a macro in my excel sheet that will copy down all of the formulas when I insert a row. I'm using the following code to do this:

Sub InsertRowFormulas ()
Selection.EntireRow.Insert
For Each cell In Intersect (ActiveSheet.UsedRange, Selection.Offset (-1, 0). EntireRow)
If cell.Has Formula Then
cell.Copy cell.Offset (1,0)
End If
Next
End Sub

However, there are some columns with an "H" in them which denotes a holiday. I would like for my macro to copy down these H's as well when inserting a new row. Any advice or help on how to do this would be greatly appreciated.

Thanks!

 

[JackDanIce]

Try:

Sub M1()

    Dim x   As Long
    Dim c   As Long
        
    Application.ScreenUpdating = False
    
    With Selection
        .EntireRow.Insert
        .SpecialCells(xlCellTypeFormulas).Copy
        .Offset(1).PasteSpecial xlPasteFormulas
        Application.CutCopyMode = False
        x = 1
        Do
            If .Cells(1, x).Value = "H" Then .Cells(2, x).Value = "H"
            x = x + 1
        Loop Until Len(.Cells(1, x).Value) = 0
    End With
                
    Application.ScreenUpdating = True
    
End Sub

 

[UTdawg]

Unfortunately that didn't work. I got an error message saying Run-time error '1004'

Application-defined or object-defined error

Any advice on what to do now?

 

[JackDanIce]

Tested and this works for me, try:

Sub M1()

    Dim r   As Range
    
    Application.ScreenUpdating = False
        
    Selection.EntireRow.Insert
    
    For Each r In Intersect(ActiveSheet.UsedRange, Selection.Offset(-1).EntireRow)
        With r
            If .HasFormula Then .Copy .Offset(1)
            If .Value = "H" Then .Offset(1).Value = "H"
        End With
    Next r
    
     With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
            
End Sub

 

[UTdawg]

Thank you, Jack! That worked! Very much appreciated.

 

[JackDanIce]

You're welcome