• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Help ..Background color to Header

Hello Friends,

I need you assistance here , I have to fill in the header of each of the worksheets for the below code with Amber .

This code is for copying data from one folder(containing multiple workbooks) to a single work book in to different worksheets .
Now when the data is copied and pasted , I need the header of each worksheet should be Amber .


Appreciate your help here





Code:
Sub RectangleRoundedCorners1_Click()

Application.DisplayAlerts = False

'*******************************************BILL*********************************
Sheet2.Range("A2:XFD1048576").Clear
'Rows("2:" & Rows.Count).ClearContents

Filename = "C:\temp\BILL.xls"
Workbooks.Open Filename:=Filename

Sheets("BILL").Select

Range("A1:AZ1000").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

Workbooks("MASTER").Activate

Sheets("BILL").Select

Range("A1").Select

ActiveSheet.Paste

Workbooks("BILL").Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close Savechanges:=False

Lastrow_bill = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
  
Set Rng = Sheet2.Range("A1:AZ" & Lastrow_bill)
    With Rng.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
  


'*****************************DELV**********************************************


Sheet3.Range("A2:XFD1048576").Clear

Filename = "C:\temp\DELV.xls"Workbooks.Open Filename:=Filename

'Workbooks.Open Filename:="C:\temp\"

Sheets("DELV").Select

Range("A1:AG3000").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

Workbooks("MASTER").Activate

Sheets("DELV").Select

Range("A1").Select

ActiveSheet.Paste

Workbooks("DELV").Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close Savechanges:=False

Lastrow_delv = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
  
Set Rng = Sheet3.Range("A1:AG" & Lastrow_delv)
    With Rng.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With


'*********************************PURO*******************************************

Sheet4.Range("A2:XFD1048576").Clear

Filename = "C:\temp\PURO.xls"
Workbooks.Open Filename:=Filename

'Workbooks.Open Filename:="C:\temp\PURO.xls"

Sheets("PURO").Select

Range("A1:BP3000").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

Workbooks("MASTER").Activate

Sheets("PURO").Select

Range("A1").Select

ActiveSheet.Paste


Workbooks("PURO").Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close Savechanges:=False

Lastrow_puro = Sheet4.Range("A" & Rows.Count).End(xlUp).Row
  
Set Rng = Sheet4.Range("A1:BP" & Lastrow_puro)
    With Rng.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With


'*********************************************PURR**********************************


Sheet5.Range("A2:XFD1048576").Clear

Filename = "C:\temp\PURR.xls"
Workbooks.Open Filename:=Filename

Sheets("PURR").Select

Range("A1:HO3000").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

Workbooks("MASTER").Activate

Sheets("PURR").Select

Range("A1").Select

ActiveSheet.Paste
Workbooks("PURR").Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close Savechanges:=False

Lastrow_purr = Sheet5.Range("A" & Rows.Count).End(xlUp).Row
  
Set Rng = Sheet5.Range("A1:HO" & Lastrow_purr)
    With Rng.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With



'***************************************************SALE********************

Sheet6.Range("A2:XFD1048576").Clear

Filename = "C:\temp\SALE.xls"
Workbooks.Open Filename:=Filename


Sheets("SALE").Select

Range("A1:CD1000").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

Workbooks("MASTER").Activate

Sheets("SALE").Select

Range("A1").Select

ActiveSheet.Paste
Workbooks("SALE").Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close Savechanges:=False
Lastrow_sale = Sheet6.Range("A" & Rows.Count).End(xlUp).Row
  
Set Rng = Sheet6.Range("A1:CD" & Lastrow_sale)
    With Rng.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

'***********************************QUOT************************************

Sheet16.Range("A2:XFD1048576").Clear

Filename = "C:\temp\QUOT.xls"
Workbooks.Open Filename:=Filename


Sheets("QUOT").Select

Range("A1:BW80000").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

Workbooks("MASTER").Activate

Sheets("QUOT").Select

Range("A1").Select

ActiveSheet.Paste
Workbooks("QUOT").Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close Savechanges:=False

Lastrow_quot = Sheet16.Range("A" & Rows.Count).End(xlUp).Row
  
Set Rng = Sheet16.Range("A1:BW" & Lastrow_quot)
    With Rng.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

Sheets("DASHBOARD").Activate

MsgBox " Done..."

End Sub
 
Last edited by a moderator:
Using the Bill as an example
Simply add either

For the Background
Code:
Set rng = Range("A1:AZ1")
With rng.Interior
  .Pattern = xlSolid
  .Color = RGB(191, 143, 0)
End With

or For the Font
Code:
Set rng = Range("A1:AZ1")
With rng.Font
  .Color = RGB(191, 143, 0)
End With
 
Back
Top