• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Opmaak

  • Onderwerp starter Onderwerp starter don42
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
D

don42

Gebruiker
Lid geworden
25 apr 2014
Berichten
800
Beste helpers,

Wie kan mij op weg helpen met het volgende
heb een blad met 7 kolommen met opmaak (blauwe cellen)
dit blad heb ik gekopieerd naar blad over met telkens 2 blanke kolommen
nu wil ik graag de opmaak kopiëren is dat mogelijk?

bvd
 

Bijlagen

Lukt het niet met kopiëren en dan plakken en dan kiezen voor 'Opmaak' (onder plakopties)
 
ik wil enkel de kleur hebben niet gehele opmaak

had zoiets gemaakt
Code: 
Dim x As String
x = 4
If Sheets("9").Cells(x, 2) = Interior.Color = &HF0B000 Then
Cells(x, 2) = Interior.Color = &HF0B000
End If
 
Gelukt maar....

Hoi allemaal

na heeel lang proberen heb ik iets wat werkt
maar de code is volgens mij korter te maken, zou het erg kunnen waarderen als een van de goeroes
er eens naar wil kijken

heb de file opmaak aangepast
tabblad 9 en een rechter muisklik (Cel b1) geeft in blad over het gewenste resultaat!

Code: 
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Range("B1"), Target) Is Nothing Then
Range("A1").Value = ActiveSheet.Name
Sheets("over").Range("f1").Value = Range("a1").Value
Range("b4:h40").Copy
Sheets("over").Range("b4").PasteSpecial Paste:=xlPasteValues
Sheets("over").Activate
Application.CutCopyMode = False
Range("a1").Select
Columns(3).Insert
Columns(4).Insert
Columns(6).Insert
Columns(7).Insert
Columns(9).Insert
Columns(10).Insert
Columns(12).Insert
Columns(13).Insert
Columns(15).Insert
Columns(16).Insert
Columns(18).Insert
Columns(19).Insert
Sheets("over").Range("ac1").Clear
Range("b4:t40").Copy







Sheets("over").Range("q1") = "wissen"
Dim d As String
Dim lastrow As Long
d = Range("n1").Value
lastrow = Cells(Rows.Count, "b").End(xlUp).Row
Dim i As Integer
For i = 4 To lastrow
If Sheets(d).Cells(i, 2).Interior.Color = &HF0B000 Then
Cells(i, 2).Interior.Color = Sheets(d).Cells(i, 2).DisplayFormat.Interior.Color
Else
End If
Next i


Dim e As String
Dim lastrow2 As Long
e = Range("n1").Value
lastrow2 = Cells(Rows.Count, "e").End(xlUp).Row
Dim i2 As Integer
For i2 = 4 To lastrow2
If Sheets(e).Cells(i2, 3).Interior.Color = &HF0B000 Then
Cells(i2, 5).Interior.Color = Sheets(e).Cells(i2, 3).DisplayFormat.Interior.Color
Else
End If
Next i2

Dim h As String
Dim lastrow3 As Long
h = Range("n1").Value
lastrow3 = Cells(Rows.Count, "h").End(xlUp).Row
Dim i3 As Integer
For i3 = 4 To lastrow3
If Sheets(h).Cells(i3, 4).Interior.Color = &HF0B000 Then
Cells(i3, 8).Interior.Color = Sheets(h).Cells(i3, 4).DisplayFormat.Interior.Color
Else
End If
Next i3

Dim k As String
Dim lastrow4 As Long
k = Range("n1").Value
lastrow4 = Cells(Rows.Count, "k").End(xlUp).Row
Dim i4 As Integer
For i4 = 4 To lastrow4
If Sheets(k).Cells(i4, 5).Interior.Color = &HF0B000 Then
Cells(i4, 11).Interior.Color = Sheets(k).Cells(i4, 5).DisplayFormat.Interior.Color
Else
End If
Next i4

Dim n As String
Dim lastrow5 As Long
n = Range("n1").Value
lastrow5 = Cells(Rows.Count, "n").End(xlUp).Row
Dim i5 As Integer
For i5 = 4 To lastrow5
If Sheets(n).Cells(i5, 6).Interior.Color = &HF0B000 Then
Cells(i5, 14).Interior.Color = Sheets(n).Cells(i5, 6).DisplayFormat.Interior.Color
Else
End If
Next i5


Dim q As String
Dim lastrow6 As Long
q = Range("n1").Value
lastrow6 = Cells(Rows.Count, "q").End(xlUp).Row
Dim i6 As Integer
For i6 = 4 To lastrow6
If Sheets(q).Cells(i6, 7).Interior.Color = &HF0B000 Then
Cells(i6, 17).Interior.Color = Sheets(q).Cells(i6, 7).DisplayFormat.Interior.Color
Else
End If
Next i6

Dim t As String
Dim lastrow7 As Long
t = Range("n1").Value
lastrow7 = Cells(Rows.Count, "t").End(xlUp).Row
Dim i7 As Integer
For i7 = 4 To lastrow7
If Sheets(t).Cells(i7, 8).Interior.Color = &HF0B000 Then
Cells(i7, 20).Interior.Color = Sheets(t).Cells(i7, 8).DisplayFormat.Interior.Color
Else
End If
Next i7

End If



End Sub

Don
 

Bijlagen

Laatst bewerkt:
Als alleen de VO niet mee moet. (verder zie ik geen verschillen) dan bv zo
Code: 
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  If Target.Address(0, 0) = "B1" Then
    With Sheets("Over")
      .Cells.Clear
      Range("B4:H40").Copy .Range("B4")
      .Cells.FormatConditions.Delete
      .Range("C:C,D:D,E:E,F:F,G:G,H:H").Insert
      .Range("D:D,F:F,H:H,J:J,L:L,N:N").Insert
      .Range("C:D,F:F,G:G,I:I,J:J,L:L,M:M,O:O,P:P,R:R,S:S").Interior.Color = xlNone
      .Range("C:D,F:F,G:G,I:I,J:J,L:L,M:M,O:O,P:P,R:R,S:S").Borders.LineStyle = xlNone
      .Range("B4:B40, E4:E40, H4:H40, K4:K40, N4:N40, Q4:Q40").Borders(xlEdgeRight).LineStyle = xlContinuous
    End With
  End If
End Sub
 
Lijkt mij meer dat de code thuis hoort in de module van blad "9" met:
Code: 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
[COLOR=#0000ff]hier je code[/COLOR]
[COLOR=#ff0000]cancel = true[/COLOR]
End Sub

En voeg de cancel = true toe.
 
Bedankt voor het meedenken/en aanpassen
hoewel het ongeveer gelijk werkt ziet het er toch net iets mooier uit (#5)
ben er blij mee en ken weer verder :thumb:
 
I.p.v.
Code: 
.Range("C:D,F:F,G:G,I:I,J:J,L:L,M:M,O:O,P:P,R:R,S:S").Interior.Color = xlNone
.Range("C:D,F:F,G:G,I:I,J:J,L:L,M:M,O:O,P:P,R:R,S:S").Borders.LineStyle = xlNone

Code: 
.Range("C:D,F:G,I:J,L:M,O:P,R:S").Clear
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan