Copy range into clipboard and paste it above rows with bold cell entries

Dear Experts:

I would like to copy and paste a selected range as follows:

This range (B2:G2) on the active worksheet is selected manually.

The macro is to copy the selection into the clipboard and paste it
above each row that has bold cell entries.

I have attached a sample file with detailed explanations for your convenience.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas


Inserting-Headers-Before-Rows-Co.xlsm
Andreas HermleTeam leaderAsked:
Who is Participating?
 
dlmilleCommented:
Here's your code which starts at row 4, then looks for Bold cells in column B, pasting the header on row 2 one row above the found bold row.

Option Explicit

Sub pasteHeaders()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim r As Range
Dim rCopyRange As Range

    Set wkb = ThisWorkbook
    Set wks = wkb.ActiveSheet
    
    Set rCopyRange = wks.Range("B2:G2")
    
    Set rng = wks.Range("B4", wks.Range("B" & wks.Rows.Count).End(xlUp))
    
    For Each r In rng
        If r.Value <> vbNullString Then
            If r.Font.Bold = True Then
                rCopyRange.Copy r.Offset(-1, 0)
            End If
        End If
    Next r
End Sub

Open in new window


PS - if you anticipate a wider header range and want to use SELECTION to dictate the header, just change line 13 to:

Set rCopyRange = Selection 'as opposed to wks.Range("B2:G2")

Cheers,

Dave

See attached.

Enjoy!

Dave
Inserting-Headers-Before-Rows-Co.xlsm
0
 
Andreas HermleTeam leaderAuthor Commented:
Hi Dave,

great! Works like a charm.

Thank you very much for your swift and professional help.

Regards, Andreas
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.