Makro-PasteSpecial och färga område

[Templo]

Hej!

 

Två saker som ställer till det för mig:

 

Problem 1

 

Kör det här för att kopiera rader från många olika

blad till en lista genom att markera område som ska

kopieras och kör makro som aktiverar "Sheet1" väljer

första cell, trycker "OK" och allt klistras in (alltid 7 kolumner

men varierande antal rader:

 

Sub kopi()

 

Dim copSource As Range

Dim copTarget As Range

 

Set copSource = Selection

Sheets("Sheet1").Select

Set copTarget = Application.InputBox( _

prompt:="Markera den cell du villklistra in till", Type:=8)

 

copSource.Copy

copTarget.Select

copTarget.Parent.Paste

 

 

End Sub

 

Men eftersom jag vill behålla formatering på Sheet1

vill jag ha med i koden:

 

"PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False"

 

men det fungerar inte när jag byter "Paste" med

ovanstående rad. Lösning någon?

 

2.

 

Är det alls möjligt att (om Problem 1 löser sig)

få samma makro att i nästa steg:

 

- förflytta sig två kolumner bort

 

- markerar samma antal rader i den kolumnen som inklistringen hade

(om inklistring område var B10:H15 ska makro markera J10:J15)

 

- ge området tjocka kanter

 

- färga området med random färg

 

Detta för att kunna urskilja enskilda blad på listan.

Låter kanske dumt men hade underlättat mitt arbete mycket.

 

 

[Monshi]

[log]Sub kopi()

 

Dim copSource As Range

Dim copTarget As Range

 

Set copSource = Selection

Sheets("Sheet1").Select

Set copTarget = Application.InputBox( _

prompt:="Markera den cell du villklistra in till", Type:=8)

 

copSource.Copy

 

copTarget.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

 

 

End Sub[/log]

borde fungera.

 

2:

Ja

[log]Dim rnTarget As Range

 

Set rnTarget = copTarget.Parent.Range(copTarget.Offset(0, copSource.Columns.Count + 2), _

copTarget.Offset(copSource.Rows.Count - 1, copSource.Columns.Count + 2))

rnTarget.Interior.Color = 1

rnTarget.BorderAround LineStyle:=xlContinuous, Weight:=xlThick, ColorIndex:=xlColorIndexAutomatic

[/log]

Fast färgen får du fixa själv. Slumpmässig? Bara jobbigt.

 

 

/T

 

Even when we know we´ll never find the answers, we have to keep on asking questions.

 

[Templo]

Hittar inte ord! :-)

 

Färgen måste jag klura själv ut annars frågar jag aldrig mer!

(finns stor risk att det blir så)

 

[Monshi]

Okej då, här får du:

[log]

Dim red As Integer

Dim blue As Integer

Dim green As Integer

Randomize

red = Int((256 * Rnd))

blue = Int((256 * Rnd))

green = Int((256 * Rnd))

Me.Range("a1").Interior.Color = RGB(red, blue, green)[/log]

 

Fast, notera att slumptal med Excel inte alltid är så slumpmässiga men det kanske inte är så viktigt här. Randomize kan man initiera med ett värde, ex.v. millisekunder, och därmed få ett "slumpmässigt" ingångsvärde i slumptals-"generatorn".

 

 

Äsch, ska vi ha lite kul också?

[log]Option Explicit

 

Dim colorRange As Range

Dim doLoop As Boolean

Dim myWaitTime As Integer

Sub MyColorizer()

Dim red As Integer

Dim blue As Integer

Dim green As Integer

Randomize

Dim myCell As Range

For Each myCell In colorRange

red = Int((256 * Rnd))

blue = Int((256 * Rnd))

green = Int((256 * Rnd))

myCell.Interior.Color = RGB(red, blue, green)

Next myCell

End Sub

 

Public Sub StartLooper(loopWaitSeconds As Integer, target As Range)

doLoop = True

Set colorRange = target

myWaitTime = loopWaitSeconds

myLooper

End Sub

Public Sub AddColorRange(target As Range)

If colorRange Is Nothing Then

Set colorRange = target

Else

Set colorRange = Union(colorRange, target)

End If

End Sub

 

Public Sub myLooper()

If doLoop Then

MyColorizer

Dim nextRun As Variant

nextRun = Now + TimeSerial(0, 0, myWaitTime)

Application.OnTime nextRun, "myLooper"

End If

End Sub

 

Public Sub stopLoop()

doLoop = False

End Sub[/log]

Kopiera koden till en modul. Lägg sedan lämpligtvis tre knappar på ett blad.

Koden för knapp ett anger du till:

Modul1.StartLooper 1, Me.Range("a1:A3")

 

Knapp två kan du lägga till fler celler med:

Modul1.AddColorRange Me.Range("C1:C3")

 

och slutligen stoppar du det hela med knapp 3:

Modul1.stopLoop

 

 

/T

 

Even when we know we´ll never find the answers, we have to keep on asking questions.

 

[Templo]

:-) :-):-):-):-):-):-):-):-):-)

 

Om någon så har du bevisat att XL kan vara rolig.

 

Mitt nästa mål är att göra Data Entry Form men jag

lovar att jag fixar det själv och sätter här för att

du ska sätta betyg.

 

Tack! Tack Tack!

 

[Monshi]

 

Försök själv och se om du inte klarar det själv. Får du problem är du även, självklart, välkommen att fråga.

 

 

/T

 

Even when we know we´ll never find the answers, we have to keep on asking questions.