Copy over color pallete from one work book to another

timspin

Board Regular
Joined
Nov 18, 2002
Messages
231
Hi

I have a workbook that uses a color pallett that I have defined. Im sucking out work sheets via a macro from another workbook to another. Trouble is the worksheet I suck out is a different color (based on the original color profile)

Any ideas??

Cheers
Tim
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

GlennUK

Well-known Member
Joined
Jul 8, 2002
Messages
11,687
Try
Code:
    ActiveWorkbook.Colors = Workbooks("originalbook.xls").Colors
 

timspin

Board Regular
Joined
Nov 18, 2002
Messages
231
Hiya

OK, Im muddling my way through this withoput really knowing what Im doing. Where would you code fit in to my code???


Dim ToBook As String
Dim ToSheet As Worksheet
Dim NumColumns As Integer
Dim ToRow As Long
Dim FromBook As String
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim LastRow As Long
'-
'=========================================================
'- MAIN ROUTINE
'=========================================================
Sub FILES_FROM_FOLDER2(WEEKNO)
Application.Calculation = xlCalculationManual
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
ToBook = ActiveWorkbook.Name
'---------------------------
'- MASTER SHEET
'---------------------------
Set ToSheet = ActiveSheet
NumColumns = ToSheet.Range("A1").End(xlToRight).Column
ToRow = ToSheet.Range("A500").End(xlUp).Row
'- clear master
If ToRow <> 1 Then
ToSheet.Range(ToSheet.Cells(2, 1), _
ToSheet.Cells(ToRow, NumColumns)).ClearContents
End If
ToRow = 2
'------------------------------------------
'- main loop to open each file in folder
'------------------------------------------
FromBook = Dir("*.xls")
While FromBook <> ""
If FromBook <> ToBook Then
Application.StatusBar = FromBook
Transfer_data2 (WEEKNO) ' subroutine below
End If
FromBook = Dir
Wend
'-- close

Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
End Sub
'


Private Sub Transfer_data2(WEEKNO2)

Workbooks.Open Filename:=FromBook
Sheets(WEEKNO2).Select
Sheets(WEEKNO2).Copy After:=Workbooks("Summary bezel.xls").Sheets(1 _
)

Workbooks(FromBook).Close savechanges:=False

End Sub
 

GlennUK

Well-known Member
Joined
Jul 8, 2002
Messages
11,687
You are "sucking" sheets from many books ... which one is the palette supposed to come from?
 

timspin

Board Regular
Joined
Nov 18, 2002
Messages
231

ADVERTISEMENT

Hi Glen

So I have say 10 workbooks in a folder. Each of these workbooks are the same (each has the same color pallete - and its this color pallete that I want in my Big Bumper work book that sucks out all the worksheets from my ten in the folder)

Cheers
Tim
 

GlennUK

Well-known Member
Joined
Jul 8, 2002
Messages
11,687
try putting:
Code:
    Workbooks("Summary bezel.xls").Colors = Workbooks(FromBook).Colors
before Workbooks(FromBook).Close savechanges:=False
in the Transfer_data2 routine. It'll copy the palette 10 times, but that doesn't matter ( as long as it doesn't slow your process down too much).
 

timspin

Board Regular
Joined
Nov 18, 2002
Messages
231

ADVERTISEMENT

Thats the one - cheers Glen I really appreciate your help!!!
Cheers
Tim
 

XL Pro

Board Regular
Joined
Apr 17, 2002
Messages
248
Office Version
  1. 365
Platform
  1. Windows
Excellent GlennUK! This is just the problem I encountered today and thanks to a simple search, I found the answer here!
 

GlennUK

Well-known Member
Joined
Jul 8, 2002
Messages
11,687
Great!

That's great! That's one of the things that makes this site so useful.

:)
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,052
Messages
5,835,144
Members
430,342
Latest member
Sailingexcel

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top