Help With Formatting A Spreadsheet Using VBA

[TkdKidSnake]

Hi all,

I have a spreadsheet that I would like to use VBA to automatically format / copy and paste certain things. The spreadsheet varies in length and currently I need to do this manually which is quite time consuming.

If anyone can help it would be greatly appreciated.

1. Copy the formats on row 6 then pastes the formats only all the way to the bottom to the last populated row using column B as this will always have something in

1. Column K6, L6, Q6 & U6 all have formula that I’d like to copy all the way to the bottom using the same criteria as in item1

Just in case you need to know I have called the workbook “002 – Raw Data.xls”


Thanks in advance.

 

[Max1616]

Try this:

Sub Formats()

Dim lrow As Long
lrow = Cells(Rows.Count, 2).End(xlUp).Row
Range("6:6").Copy
Range("6:" & lrow).PasteSpecial Paste:=xlPasteFormats
Range("K6:L6").Copy
Range("K6:L" & lrow).PasteSpecial Paste:=xlPasteFormulas
Range("Q6").Copy
Range("Q6:Q" & lrow).PasteSpecial Paste:=xlPasteFormulas
Range("U6").Copy
Range("U6:U" & lrow).PasteSpecial Paste:=xlPasteFormulas

End Sub

 

[Fluff]

How about

Sub CopyFormat()

   Dim UsdRws As Long
   UsdRws = Range("B" & Rows.Count).End(xlUp).Row
   
   Intersect(Range("K6:U" & UsdRws), Range("K:L,Q:Q,U:U")).FillDown
   Range("A6:U6").Copy
   Range("A7:[COLOR=#ff0000]U[/COLOR]" & UsdRws).PasteSpecial xlPasteFormats
   Application.CutCopyMode = False
End Sub

Change the value in red to match your final column

 

[TkdKidSnake]

Excellent thanks works a treat

Try this:

Sub Formats()

Dim lrow As Long
lrow = Cells(Rows.Count, 2).End(xlUp).Row
Range("6:6").Copy
Range("6:" & lrow).PasteSpecial Paste:=xlPasteFormats
Range("K6:L6").Copy
Range("K6:L" & lrow).PasteSpecial Paste:=xlPasteFormulas
Range("Q6").Copy
Range("Q6:Q" & lrow).PasteSpecial Paste:=xlPasteFormulas
Range("U6").Copy
Range("U6:U" & lrow).PasteSpecial Paste:=xlPasteFormulas

End Sub

 

[TkdKidSnake]

Excellent thanks both options work a treat

How about

Sub CopyFormat()

   Dim UsdRws As Long
   UsdRws = Range("B" & Rows.Count).End(xlUp).Row
   
   Intersect(Range("K6:U" & UsdRws), Range("K:L,Q:Q,U:U")).FillDown
   Range("A6:U6").Copy
   Range("A7:[COLOR=#ff0000]U[/COLOR]" & UsdRws).PasteSpecial xlPasteFormats
   Application.CutCopyMode = False
End Sub

Change the value in red to match your final column

 

[Fluff]

Glad we could help & thanks for the feedback