Copy and paste Range to top of dynamic rows

[Dave8899]

Hi all, I need a VBA to add the Colume Headings Range A1:N1 in to the next empty Row, I need to keep The formating etc.

using the pictuer as an example i would like to copy row A to the top of the Transport and top of HQ, the amount of rows in transport and HQ can be different every time.

 

[Peter_SSs]

First a few suggestions

1. Investigate XL2BB for providing sample data to make it easier for helpers by not having to manually type out sample data to test with.
2. Update your Account details (click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)
3. Be careful with your terminology so as to not confuse your helpers. eg "I would like to copy row A". A is a column, not a row. I assume you want to copy row 1?

Try this with a copy of your workbook.

Sub Copy_Headings()
  Range("A1:N1").Copy Destination:=Columns("A").SpecialCells(xlBlanks)
End Sub

 

[Dave8899]

Hi Peter, thansk for the help, it dod not work in the end but i found a work around, by using, the below code, its not elegant but gets teh job done

Sub Head()
 

   Dim Rng As Range
   
   For Each Rng In Range("a2", Range("a" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
      With Rng.Offset(Rng.Count).Resize(1)
         
     
    .Offset(1, 0) = "Company ref No"
    .Offset(1, 1) = "Department"
    .Offset(1, 2) = "POC"
    .Offset(1, 3) = "Date"
    .Offset(1, 4) = "Item"
    .Offset(1, 5) = "Status"
   
    
    .Offset(1, 0).Interior.Color = RGB(192, 192, 192)
    .Offset(1, 1).Interior.Color = RGB(192, 192, 192)
    .Offset(1, 2).Interior.Color = RGB(192, 192, 192)
    .Offset(1, 3).Interior.Color = RGB(192, 192, 192)
    .Offset(1, 4).Interior.Color = RGB(192, 192, 192)
    .Offset(1, 5).Interior.Color = RGB(192, 192, 192)
  
   
    
    
    .Offset(1, 0).Font.Bold = True
    .Offset(1, 1).Font.Bold = True
    .Offset(1, 2).Font.Bold = True
    .Offset(1, 3).Font.Bold = True
    .Offset(1, 4).Font.Bold = True
    .Offset(1, 5).Font.Bold = True
     
     
        With Selection
            
         
        End With
    
         
      End With
   Next Rng
   
  Call Dell
  
End Sub

 
Sub Dell()

   lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Rows(lastrow).Delete
End Sub

 

[Peter_SSs]

Glad you have something that works. From your code it appears that both your layout and requirement has changed from what you originally posted.
That code on your posted data would over-write some data in the top row of each block. I assume then that you actually have two blank rows between each data block?

You also said you needed headings from A:N copied but your code only does A:F and it introduced formatting that was not shown in your first image when you said "I need to keep the formatting"

Since your code does what you want, you may consider this briefer version which I think should do the same thing. I have assumed two blank rows between each block of data.

Sub Head_v2()
  Dim Rng As Range
 
  For Each Rng In Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlBlanks).Areas
    With Rng.Rows(2).Resize(, 6)
      .Value = Array("Company ref No", "Department", "POC", "Date", "Item", "Status")
      .Interior.Color = RGB(192, 192, 192)
      .Font.Bold = True
    End With
  Next Rng
End Sub

 

[Dave8899]

Hi Sorry Peter, i cut some of the Code out when i posted my solutions it as it was repetative, and sorry the 2 row thing was added after the firts post,

Your code is so much more elegant and quicker.

Thanks, I've now added that it works a treat and is so much faster on the larger reports

 

[Peter_SSs]

Cheers. Then one more suggestion if you are doing A:N, instead of listing all those individual headings in the code, if they are the same as row 1 then instead of

.Value = Array(".....

try something like

.Value = Range("A1:N1").Value

 

[Dave8899]

that’s fantastic and will be a grate help as it will adjust if I have to cheer the headings, thanks again

 

[Peter_SSs]

You're welcome.

 

[smozgur]

Note: Switched the solution post to provide faster help to future readers.