Link color of cell range between sheets

T

thomas819

New Member
Joined
Nov 23, 2020
Messages
36
Office Version
  1. 2019
Platform
  1. Windows
Hello,
I would like to ask a simple question.
I would like to link colors from cell range 'Sheet x'!B2:B15 to Sheet2!K2:K15 and colors from cell range 'Sheet x'!C2:C15 to Sheet2!T2:T15

Snímka.JPG


I have over 30 such transformation and is very time consuming. I am sure this task could be automated by VBA quite simple, but it is currently beyond my capability...

Thanks,
Thomas
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Sort by date Sort by votes
I would recommend turning on your Macro Recorder, and then record yourself using the Format Painter to copy the formatting of the first range to your second.
This should give you most of the code that you need.

If you need to copy the same formatting to multiple sheets, you can imbed that code in a loop. We can help you do that, if you want.
Just let us know all the sheets in your workbook, and which ones need to be updated.
 
Upvote 0
Hi Joe,
I tried Macro Recorder, but it wasn't any help...
It would be enormous help if you could help me with this issue...
Here is my situation:
input.jpg

This is used as input data point.

I need to change it to this format:
result.JPG

At this moment I just copy formatting of column C (picture1) using paint brush. Then copy it to column B (picture2).
Then I copy format of column E (picture1) and copy it to column C (picture2)... and so on and so on...
It is very boring task which I would like to deligate to VBA :)
But at this moment is beyond my capability.

Your help will be greatly appreciated
 
Upvote 0
thomas819 said:
At this moment I just copy formatting of column C (picture1) using paint brush. Then copy it to column B (picture2).
Then I copy format of column E (picture1) and copy it to column C (picture2)... and so on and so on...
Click to expand...
Yes, that is exactly what I am asking you to do with the Macro Recorder. That will give us a big piece of the VBA code that we need to automate it.
The Macro Recorder doesn't automate the process itself, but gives us code snippets that we need to use (this is a very helpful tool you can use to get code snippets - let Excel figure out the needed VBA you need instead of trying to figure it out yourself!).

So, what I need you to do is record yourself doing it to the first few, then stop the Macro Recorder and post the code here for us to see/use.
Then, explain the details of all the other ranges that need to be copied, so we can incorporate that into the building blocks of your recorded code.

Please complete those 2 tasks, and we should be able to help you.
 
Upvote 0
As you requested.
I copied first 10 columns (picture2) from corresponded columns in Article list(picture1)
Here is recorded Makro1:
VBA Code: 
Sub Makro1()
'
' Makro1 Makro
'

'
    Range("C5:C34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Article list").Select
    Application.CutCopyMode = False
    Range("E5:E34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("G5:G34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("D5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("I5:I34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("K5:K34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("F5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("M5:M34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("O5:O34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("H5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("Q5:Q34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("I5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("S5:S34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("J5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("U5:U34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("K5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

I hope this will help you :)
 
Upvote 0
thomas819 said:
I hope this will help you
Click to expand...
That is only the first task I asked for. I need to know the details of the second task.
Joe4 said:
Then, explain the details of all the other ranges that need to be copied, so we can incorporate that into the building blocks of your recorded code.
Click to expand...

I think I see that pattern from your code. I would just then need to know what the last range you want to copy is.
If you tell me that, I think I can get what you need.
 
Upvote 0
Hi Joe, here is Makro1 with important comments. I hope that clear thing up :)
VBA Code: 
Sub Makro1()
' Makro1 Makro
    Range("C5:C34").Select      'this is range from sheet "Article list"
    Selection.Copy              'here I selected paint brush
    Sheets("Sumary").Select
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False     'here I clicked on "SumaryB5" and formating stored in paint brush was copied, then I hit ESC
    Sheets("Article list").Select               'this is all... then I repeated this process 10 times over...
    Application.CutCopyMode = False
    Range("E5:E34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("G5:G34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("D5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("I5:I34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("K5:K34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("F5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("M5:M34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("O5:O34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("H5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("Q5:Q34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("I5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("S5:S34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("J5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("U5:U34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("K5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

List of all ranges (copied color from "Article list" to "Sumary")
'Article list'!C5:C34 --->> Sumary!B5:B34
'Article list'!C5:C34 --->> Sumary!B5:B34
'Article list'!C5:C34 --->> Sumary!B5:B34
'Article list'!C5:C34 --->> Sumary!B5:B34
'Article list'!C5:C34 --->> Sumary!B5:B34
'Article list'!C5:C34 --->> Sumary!B5:B34
'Article list'!C5:C34 --->> Sumary!B5:B34
'Article list'!C5:C34 --->> Sumary!B5:B34
 
Upvote 0
Hi Joe, here is Makro1 with important comments. I hope that clear thing up :)
VBA Code: 
Sub Makro1()
' Makro1 Makro
    Range("C5:C34").Select      'this is range from sheet "Article list"
    Selection.Copy              'here I selected paint brush
    Sheets("Sumary").Select
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False     'here I clicked on "SumaryB5" and formating stored in paint brush was copied, then I hit ESC
    Sheets("Article list").Select               'this is all... then I repeated this process 10 times over...
    Application.CutCopyMode = False
    Range("E5:E34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("G5:G34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("D5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("I5:I34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("K5:K34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("F5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("M5:M34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("O5:O34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("H5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("Q5:Q34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("I5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("S5:S34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("J5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Article list").Select
    Range("U5:U34").Select
    Selection.Copy
    Sheets("Sumary").Select
    Range("K5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

List of all ranges (copied color from "Article list" to "Sumary")
'Article list'!C5:C34 --->> Sumary!B5:B34
'Article list'!E5:E34 --->> Sumary!C5:C34
'Article list'!G5:G34 --->> Sumary!D5:D34
'Article list'!I5:I34 --->> Sumary!E5:E34
'Article list'!K5:K34 --->> Sumary!F5:F34
'Article list'!M5:M34 --->> Sumary!G5:G34
'Article list'!O5:O34 --->> Sumary!H5:H34
'Article list'!Q5:Q34 --->> Sumary!I5:I34
'Article list'!S5:S34 --->> Sumary!J5:J34
'Article list'!U5:U34 --->> Sumary!K5:K34
'Article list'!W5:W34 --->> Sumary!L5:L34
'Article list'!Y5:Y34 --->> Sumary!M5:M34
'Article list'!AA5:AA34 --->> Sumary!N5:N34
'Article list'!AC5:AC34 --->> Sumary!O5:O34
'Article list'!AE5:AE34 --->> Sumary!P5:P34
'Article list'!AG5:AG34 --->> Sumary!Q5:Q34
'Article list'!AI5:AI34 --->> Sumary!R5:R34
'Article list'!AK5:AK34 --->> Sumary!S5:S34
'Article list'!AM5:AM34 --->> Sumary!T5:T34
'Article list'!AO5:AO34 --->> Sumary!U5:U34
'Article list'!AQ5:AQ34 --->> Sumary!V5:V34
'Article list'!AS5:AS34 --->> Sumary!W5:W34
'Article list'!AU5:AU34 --->> Sumary!X5:X34
'Article list'!AW5:AW34 --->> Sumary!Y5:Y34
'Article list'!AY5:AY34 --->> Sumary!Z5:Z34
'Article list'!BA5:BA34 --->> Sumary!AA5:AA34
'Article list'!BC5:BC34 --->> Sumary!AB5:AB34
'Article list'!BE5:BE34 --->> Sumary!AC5:AC34
'Article list'!BG5:BG34 --->> Sumary!AD5:AD34
'Article list'!BI5:BI34 --->> Sumary!AE5:AE34
'Article list'!BK5:BK34 --->> Sumary!AF5:AF34
 
Upvote 0
Would you believe that whole macro can be reduced to this?
VBA Code: 
Sub Makro1()

    Dim col As Long
    
    Application.ScreenUpdating = False
    
'   Loop through every other column from C (3) to BK (63)
    For col = 3 To 63 Step 2
        Sheets("Article list").Range(Cells(5, col), Cells(34, col)).Copy
        Sheets("Sumary").Cells(5, (col + 1) / 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Next col
  
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
Solution
Joe, you are indeed brilliant :)
Thank you a million

Sorry for delay, but I was busy
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Automatically setting filters based upon user selection criteria
Replies
1
Views
152
John_w
J
The Ruff Report
  • Solved
VBA - replace a character in a range to save
Replies
5
Views
180
RobP
R
J
  • Question
Set cell color based on another cell color
Replies
3
Views
526
bobsan42
bobsan42
G
  • Question
VBA help - copy cells from specific table to specific table on another sheet.
Replies
0
Views
294
GardianAngelUK
G
Rixn
  • Question
Conditional formatting cell color based on a number range.
Replies
4
Views
332
awoohaw
awoohaw

Forum statistics

Threads
1,215,005
Messages
6,122,661
Members
449,091
Latest member
peppernaut

Share this page

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
Back
Top