Kopiera färgläggning från bladx till blad1

[Freppa87 0]

Hej,

 

jag har x antal flikar där jag har olika färgscheman på kolumnerna. Jag tycker det är rörigt att behöva gå igenom varje enskild flik för att få fram dessa.

Min tanke är att jag har gjort en summeringsflik (blad1) som har Variabler i y-led och fliknamn i x-led.

 

Jag har försökt anpassa denna koden men får att att indexet är utanför intervall.

 

      Sub WorksheetLoop()

         Dim WS_Count As Integer
         Dim I As Integer

         ' Set WS_Count equal to the number of worksheets in the active
         ' workbook.
         WS_Count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For I = 2 To WS_Count

            
           
        Worksheets("Blad" & I).Range("A2:A31").Interior.Color = Worksheets("Blad1").Range("B2:B31").Interior.Color

         Next I

      End Sub
 

 

Jag har fortfarande inte löst hur jag skall göra för att ändra rangen för andra Range satsen, då den skall även skall stega ett steg per iteration.

 

//Fredrik

[MH_ 382]

OFFSET  med (i-2) raders förskjutning

Worksheets("Blad" & I).Range("A2:A31").Interior.Color = _

Worksheets("Blad1").Range("B2:B31").Offset(rowOffset:=0, columnOffset:=(I - 2)).Interior.Color

 

Men(1) den här raden hämtar färg FRÅN blad1 TILL blad x, dvs tvärs emot vad du säger i rubriken (det som står till vänster om "= " tilldelas ju värdet/egenskapen)

Om rubriken stämmer vill du ha:

Worksheets("Blad1").Range("B2:B31").Offset(rowOffset:=0, columnOffset:=(I - 2)).Interior.Color= _

Worksheets("Blad" & I).Range("A2:A31").Interior.Color 

 

Men(2) VBA kommer bara att hämta color-koden från den första cellen till höger om likhetstecknet.  Om du har blandade färger så verkar den göra något slag summering/0-ställning så att färgen blir svart .

Om du har flera olika färger på ett blad/kolumn kan du köra en "inre" loop som går igenom varje cell istället för att försöka kopiera områdets formatering:

 

DIM x As integer

For I = 2 To WS_Count
    For x = 2 To 31
        Worksheets("Blad" & I).Range("A2:A31").Cells(x).Interior.Color = _
        Worksheets("Blad1").Range("B2:B31").Offset(rowOffset:=0, columnOffset:=(I - 2)).Cells(x).Interior.Color
    Next x
Next I

 

 

 

För att kopiera områdets formatering  kan du köra klassisk klistra in special-format:
 

For I = 2 To WS_Count
        Worksheets("Blad1").Range("B2:B31").Offset(rowOffset:=0, columnOffset:=(I - 2)).Copy
        Worksheets("Blad" & I).Range("A2:A31").PasteSpecial Paste:=xlPasteFormats
Next I

hämtar från blad i och kopierar till blad x. Vänd på koden vid behov.

För en gångs skull rekommenderar jag att du kör en select någonstans i koden. Annars kan "Paste"  hamna lite varsomhelst om du har en markering när du påbörjar makrot.