• 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.

Wijzigingen

Status
Niet open voor verdere reacties.
T

Thuban123

Gebruiker
Lid geworden
5 sep 2012
Berichten
23
Beste hulpzame leden,
Ik heb een vraag en die luidt:
Ik heb twee Tabbladen in Excel. Ze zijn bijna hetzelfde alleen veranderen er in de blad2 verschillende cellen zoals bijv een status-change of aantalen. Hoe kan ik de verschillen automatisch doorvoeren in de oude tabblad. Dus Tab1 is een totaaloverzicht en Tab2 is een deel van tab1 maar dan met wijzigingen en niet-wijzigingen. Ik weet dat een MAcro dit kan oplossen maar ik heb hier helaas geen verstand van. Bijvoorbaat dank!
 
Veel kans dat je daar geen macro voor nodig hebt.
Maar zonder bestand is dat koffiedik kijken.
 
Ik krijg hem niet aan t draaien. Als ik een knop toevoeg met de macrocode krijg ik de volgende melding: Het argument is niet optioneel.

Edit2:
Ik zie dat als ik gegevens wijzig in blad2 ze automatisch wijzigen in blad1. In mijn situatie wijzig ik niks, ik krijg blad2 van iemand anders en wil dan de wijzigingen (dus achteraf) allemaal doorvoeren, vandaar dat ik automatisch al dacht aan een knop.

Bedankt Cobbe!
 
Laatst bewerkt door een moderator:
Test het eens.
In module van Blad2.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
 With Sheets("Blad1")
  If Not Intersect(Target, Range("A:C")) Is Nothing Then
   Set c = .Columns(1).Find(Cells(Target.Row, 1), , xlValues, xlWhole)
If Not c Is Nothing Then
  c.Resize(, 3) = Cells(Target.Row, 1).Resize(, 3).Value
Else
  .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 3) = Cells(Target.Row, 1).Resize(, 3).Value
End If
    .Cells(1).CurrentRegion.Offset(1).Sort .Range("A2")
  End If
 End With
End Sub
 
Uw reactie was wel niet erg duidelijk, ik dacht dat dit afgehandeld was, maar heb nu de code om achter een button te hangen:

Code: 
Sub cobbe()
On Error GoTo bijplakken
For Each cl In Sheets("Blad2").Range("A2:A" & Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Row)
   Set c = Sheets("Blad1").Range("A:a").Find(cl, LookIn:=xlValues)
    If Not c Is Nothing Then cl.Resize(, 3).Copy Sheets("Blad1").Range(c.Address)
Next
Exit Sub
bijplakken:
      cl.Resize(, 3).Copy Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row + 1)
End Sub
 
Laatst bewerkt:
Cobbe zei:
Uw reactie was wel niet erg duidelijk, ik dacht dat dit afgehandeld was, maar heb nu de code om achter een button te hangen:

Code: 
Sub cobbe()
On Error GoTo bijplakken
For Each cl In Sheets("Blad2").Range("A2:A" & Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Row)
   Set c = Sheets("Blad1").Range("A:a").Find(cl, LookIn:=xlValues)
    If Not c Is Nothing Then cl.Resize(, 3).Copy Sheets("Blad1").Range(c.Address)
Next
Exit Sub
bijplakken:
      cl.Resize(, 3).Copy Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row + 1)
End Sub
Klik om te vergroten...

Topie:thumb:, kan je de code aanpassen zodat de wijizgingen rood worden? Dan is het zichbaar wat er is verandert.
 
Kijk eens of deze vodoet: maar dan wel geel.:)

Code: 
Sub cobbe()
For Each cl In Sheets("Blad2").Range("A2:A" & Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Row)
   gevonden = 0
   Set c = Sheets("Blad1").Range("A:a").Find(cl, LookIn:=xlValues)
    If Not c Is Nothing Then
      gevonden = 1
       With Sheets("Blad2")
         If .Range("A" & cl.Row) <> Sheets("Blad1").Range("A" & c.Row) Or .Range("B" & cl.Row) <> Sheets("Blad1").Range("B" & c.Row) Or .Range("C" & cl.Row) <> Sheets("Blad1").Range("C" & c.Row) Then
           cl.Resize(, 3).Copy Sheets("Blad1").Range(c.Address)
             Sheets("Blad1").Range(c.Address).Interior.ColorIndex = 6
         End If
       End With
    End If
  If gevonden = 0 Then
    With cl.Resize(, 3)
        .Copy Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row + 1)
            Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row).Resize(, 3).Interior.ColorIndex = 6
    End With
  End If
Next
End Sub
 
Cobbe zei:
Kijk eens of deze vodoet: maar dan wel geel.:)

Code: 
Sub cobbe()
For Each cl In Sheets("Blad2").Range("A2:A" & Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Row)
   gevonden = 0
   Set c = Sheets("Blad1").Range("A:a").Find(cl, LookIn:=xlValues)
    If Not c Is Nothing Then
      gevonden = 1
       With Sheets("Blad2")
         If .Range("A" & cl.Row) <> Sheets("Blad1").Range("A" & c.Row) Or .Range("B" & cl.Row) <> Sheets("Blad1").Range("B" & c.Row) Or .Range("C" & cl.Row) <> Sheets("Blad1").Range("C" & c.Row) Then
           cl.Resize(, 3).Copy Sheets("Blad1").Range(c.Address)
             Sheets("Blad1").Range(c.Address).Interior.ColorIndex = 6
         End If
       End With
    End If
  If gevonden = 0 Then
    With cl.Resize(, 3)
        .Copy Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row + 1)
            Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row).Resize(, 3).Interior.ColorIndex = 6
    End With
  End If
Next
End Sub
Klik om te vergroten...


Alleen de contractnummer van de desbetreffende rij / Alleen de cellen in Kolom A worden gemarkeerd van de desbetreffende rij die verandert. Dit is niet erg (het geeft een beeld van welke rij is gewijzigd) maar waar ik op doelde is dat de daadwerkelijke Cel die wordt aangepast wordt gemarkeerd (dit gebeurt wel bij het toevoegen van nieuwe rijen, niet bij het wijzigen).
 
Dan zal het zo wel goed zijn zeker?

PS: Je moet niet steeds het hele vorige bericht herhalen.(Je gaat anders op uw vingers getikt worden!);:eek:

Code: 
Sub cobbe()
For Each cl In Sheets("Blad2").Range("A2:A" & Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Row)
   gevonden = 0
   Set c = Sheets("Blad1").Range("A:a").Find(cl, LookIn:=xlValues)
    If Not c Is Nothing Then
      gevonden = 1
       With Sheets("Blad2")
         If .Range("A" & cl.Row) <> Sheets("Blad1").Range("A" & c.Row) Then cl.Copy Sheets("Blad1").Range("A" & c.Row): Sheets("Blad1").Range("A" & c.Row).Interior.ColorIndex = 3
         If .Range("B" & cl.Row) <> Sheets("Blad1").Range("B" & c.Row) Then cl.Offset(, 1).Copy Sheets("Blad1").Range("B" & c.Row): Sheets("Blad1").Range("B" & c.Row).Interior.ColorIndex = 3
         If .Range("C" & cl.Row) <> Sheets("Blad1").Range("C" & c.Row) Then cl.Offset(, 2).Copy Sheets("Blad1").Range("C" & c.Row): Sheets("Blad1").Range("C" & c.Row).Interior.ColorIndex = 3
       End With
    End If
  If gevonden = 0 Then
    With cl.Resize(, 3)
        .Copy Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row + 1)
            Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row).Resize(, 3).Interior.ColorIndex = 6
    End With
  End If
Next
End Sub
 
Cobbe zei:
Dan zal het zo wel goed zijn zeker?

PS: Je moet niet steeds het hele vorige bericht herhalen.(Je gaat anders op uw vingers getikt worden!);:eek:

Code: 
Sub cobbe()
For Each cl In Sheets("Blad2").Range("A2:A" & Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Row)
   gevonden = 0
   Set c = Sheets("Blad1").Range("A:a").Find(cl, LookIn:=xlValues)
    If Not c Is Nothing Then
      gevonden = 1
       With Sheets("Blad2")
         If .Range("A" & cl.Row) <> Sheets("Blad1").Range("A" & c.Row) Then cl.Copy Sheets("Blad1").Range("A" & c.Row): Sheets("Blad1").Range("A" & c.Row).Interior.ColorIndex = 3
         If .Range("B" & cl.Row) <> Sheets("Blad1").Range("B" & c.Row) Then cl.Offset(, 1).Copy Sheets("Blad1").Range("B" & c.Row): Sheets("Blad1").Range("B" & c.Row).Interior.ColorIndex = 3
         If .Range("C" & cl.Row) <> Sheets("Blad1").Range("C" & c.Row) Then cl.Offset(, 2).Copy Sheets("Blad1").Range("C" & c.Row): Sheets("Blad1").Range("C" & c.Row).Interior.ColorIndex = 3
       End With
    End If
  If gevonden = 0 Then
    With cl.Resize(, 3)
        .Copy Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row + 1)
            Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row).Resize(, 3).Interior.ColorIndex = 6
    End With
  End If
Next
End Sub
Klik om te vergroten...

Bedankt & Excuses!

Dit is m precies! Hoe krijg ik trouwens het bereik groter, dus in dit geval tot en met Kolom M. Ik heb het zelf geprobeerd maar ik krijg een object fout:

Code: 
Sub Button4_Click()
For Each cl In Sheets("Newalles").Range("A2:A" & Sheets("Newalles").Range("A" & Rows.Count).End(xlUp).Row)
   gevonden = 0
   Set c = Sheets("ALLES").Range("A:a").Find(cl, LookIn:=xlValues)
    If Not c Is Nothing Then
      gevonden = 1
       With Sheets("Newalles")
         If .Range("A" & cl.Row) <> Sheets("ALLES").Range("A" & m.Row) Then cl.Copy Sheets("ALLES").Range("A" & c.Row): Sheets("ALLES").Range("A" & c.Row).Interior.ColorIndex = 3
         If .Range("B" & cl.Row) <> Sheets("ALLES").Range("B" & m.Row) Then cl.Offset(, 1).Copy Sheets("ALLES").Range("B" & c.Row): Sheets("ALLES").Range("B" & c.Row).Interior.ColorIndex = 3
         If .Range("C" & cl.Row) <> Sheets("ALLES").Range("C" & m.Row) Then cl.Offset(, 2).Copy Sheets("ALLES").Range("C" & c.Row): Sheets("ALLES").Range("C" & c.Row).Interior.ColorIndex = 3
         If .Range("D" & cl.Row) <> Sheets("ALLES").Range("D" & m.Row) Then cl.Offset(, 3).Copy Sheets("ALLES").Range("D" & c.Row): Sheets("ALLES").Range("D" & c.Row).Interior.ColorIndex = 3
         If .Range("E" & cl.Row) <> Sheets("ALLES").Range("E" & m.Row) Then cl.Offset(, 4).Copy Sheets("ALLES").Range("E" & c.Row): Sheets("ALLES").Range("E" & c.Row).Interior.ColorIndex = 3
         If .Range("F" & cl.Row) <> Sheets("ALLES").Range("F" & m.Row) Then cl.Offset(, 5).Copy Sheets("ALLES").Range("F" & c.Row): Sheets("ALLES").Range("F" & c.Row).Interior.ColorIndex = 3
         If .Range("G" & cl.Row) <> Sheets("ALLES").Range("G" & m.Row) Then cl.Offset(, 6).Copy Sheets("ALLES").Range("G" & c.Row): Sheets("ALLES").Range("G" & c.Row).Interior.ColorIndex = 3
         If .Range("H" & cl.Row) <> Sheets("ALLES").Range("H" & m.Row) Then cl.Offset(, 7).Copy Sheets("ALLES").Range("H" & c.Row): Sheets("ALLES").Range("H" & c.Row).Interior.ColorIndex = 3
         If .Range("I" & cl.Row) <> Sheets("ALLES").Range("I" & m.Row) Then cl.Offset(, 8).Copy Sheets("ALLES").Range("I" & c.Row): Sheets("ALLES").Range("I" & c.Row).Interior.ColorIndex = 3
         If .Range("J" & cl.Row) <> Sheets("ALLES").Range("J" & m.Row) Then cl.Offset(, 9).Copy Sheets("ALLES").Range("J" & c.Row): Sheets("ALLES").Range("J" & c.Row).Interior.ColorIndex = 3
         If .Range("K" & cl.Row) <> Sheets("ALLES").Range("K" & m.Row) Then cl.Offset(, 10).Copy Sheets("ALLES").Range("K" & c.Row): Sheets("ALLES").Range("K" & c.Row).Interior.ColorIndex = 3
         If .Range("L" & cl.Row) <> Sheets("ALLES").Range("L" & m.Row) Then cl.Offset(, 11).Copy Sheets("ALLES").Range("L" & c.Row): Sheets("ALLES").Range("L" & c.Row).Interior.ColorIndex = 3
         If .Range("M" & cl.Row) <> Sheets("ALLES").Range("M" & m.Row) Then cl.Offset(, 12).Copy Sheets("ALLES").Range("M" & c.Row): Sheets("ALLES").Range("M" & c.Row).Interior.ColorIndex = 3
         End With
    End If
  If gevonden = 0 Then
    With cl.Resize(, 3)
        .Copy Sheets("ALLES").Range("A" & Sheets("ALLES").Range("A" & Rows.Count).End(xlUp).Row + 1)
            Sheets("ALLES").Range("A" & Sheets("ALLES").Range("A" & Rows.Count).End(xlUp).Row).Resize(, 3).Interior.ColorIndex = 6
    End With
  End If
Next
End Sub
 
Ja gij zijt mij een goeie!
Je laat me 5 keer de code uitwerken voor 3 kolommen en nu na al die aanpassingen kom je zeggen dat het eigenlijk om te lachen was en dat het eigenlijke bereik véél groter is.
 
Cobbe zei:
Ja gij zijt mij een goeie!
Je laat me 5 keer de code uitwerken voor 3 kolommen en nu na al die aanpassingen kom je zeggen dat het eigenlijk om te lachen was en dat het eigenlijke bereik véél groter is.
Klik om te vergroten...

Dit was de laatste vraag. Ik waardeer je antwoorden zeer!! Ik heb een voorbeeldbestand geupload aangezien ik de bedrijfsgegevens niet mag uploaden. Ik heb enkel een groter bereik nodig ik dank je zeer voor je zeer nuttige input.
 
Hier is de code voor kolom A tot en met kolom M :
Het hoeft niet de laatste vraag te zijn maar soms is het frustrerend omdat de vraagstelling niet duidelijk/correct is.
En dit is zeker niet persoonlijk bedoeld.:thumb:

Code: 
Sub cobbe()
For Each cl In Sheets("Blad2").Range("A2:A" & Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Row)
   gevonden = 0
   Set c = Sheets("Blad1").Range("A:a").Find(cl, LookIn:=xlValues)
    If Not c Is Nothing Then
      gevonden = 1
       With Sheets("Blad2")
         If .Range("A" & cl.Row) <> Sheets("Blad1").Range("A" & c.Row) Then cl.Copy Sheets("Blad1").Range("A" & c.Row): Sheets("Blad1").Range("A" & c.Row).Interior.ColorIndex = 3
         If .Range("B" & cl.Row) <> Sheets("Blad1").Range("B" & c.Row) Then cl.Offset(, 1).Copy Sheets("Blad1").Range("B" & c.Row): Sheets("Blad1").Range("B" & c.Row).Interior.ColorIndex = 3
         If .Range("C" & cl.Row) <> Sheets("Blad1").Range("C" & c.Row) Then cl.Offset(, 2).Copy Sheets("Blad1").Range("C" & c.Row): Sheets("Blad1").Range("C" & c.Row).Interior.ColorIndex = 3
         If .Range("D" & cl.Row) <> Sheets("Blad1").Range("D" & c.Row) Then cl.Offset(, 3).Copy Sheets("Blad1").Range("D" & c.Row): Sheets("Blad1").Range("D" & c.Row).Interior.ColorIndex = 3
         If .Range("E" & cl.Row) <> Sheets("Blad1").Range("E" & c.Row) Then cl.Offset(, 4).Copy Sheets("Blad1").Range("E" & c.Row): Sheets("Blad1").Range("E" & c.Row).Interior.ColorIndex = 3
         If .Range("F" & cl.Row) <> Sheets("Blad1").Range("F" & c.Row) Then cl.Offset(, 5).Copy Sheets("Blad1").Range("F" & c.Row): Sheets("Blad1").Range("F" & c.Row).Interior.ColorIndex = 3
         If .Range("G" & cl.Row) <> Sheets("Blad1").Range("G" & c.Row) Then cl.Offset(, 6).Copy Sheets("Blad1").Range("G" & c.Row): Sheets("Blad1").Range("G" & c.Row).Interior.ColorIndex = 3
         If .Range("H" & cl.Row) <> Sheets("Blad1").Range("H" & c.Row) Then cl.Offset(, 7).Copy Sheets("Blad1").Range("H" & c.Row): Sheets("Blad1").Range("H" & c.Row).Interior.ColorIndex = 3
         If .Range("I" & cl.Row) <> Sheets("Blad1").Range("I" & c.Row) Then cl.Offset(, 8).Copy Sheets("Blad1").Range("I" & c.Row): Sheets("Blad1").Range("I" & c.Row).Interior.ColorIndex = 3
         If .Range("J" & cl.Row) <> Sheets("Blad1").Range("J" & c.Row) Then cl.Offset(, 9).Copy Sheets("Blad1").Range("J" & c.Row): Sheets("Blad1").Range("J" & c.Row).Interior.ColorIndex = 3
         If .Range("K" & cl.Row) <> Sheets("Blad1").Range("K" & c.Row) Then cl.Offset(, 10).Copy Sheets("Blad1").Range("K" & c.Row): Sheets("Blad1").Range("K" & c.Row).Interior.ColorIndex = 3
         If .Range("L" & cl.Row) <> Sheets("Blad1").Range("L" & c.Row) Then cl.Offset(, 11).Copy Sheets("Blad1").Range("L" & c.Row): Sheets("Blad1").Range("L" & c.Row).Interior.ColorIndex = 3
         If .Range("M" & cl.Row) <> Sheets("Blad1").Range("M" & c.Row) Then cl.Offset(, 12).Copy Sheets("Blad1").Range("M" & c.Row): Sheets("Blad1").Range("M" & c.Row).Interior.ColorIndex = 3
       End With
    End If
  If gevonden = 0 Then
    With cl.Resize(, 13)
        .Copy Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row + 1)
            Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row).Resize(, 13).Interior.ColorIndex = 6
    End With
  End If
Next
End Sub
 
:thumb:
Cobbe zei:
Hier is de code voor kolom A tot en met kolom M :
Het hoeft niet de laatste vraag te zijn maar soms is het frustrerend omdat de vraagstelling niet duidelijk/correct is.
En dit is zeker niet persoonlijk bedoeld.:thumb:

Code: 
Sub cobbe()
For Each cl In Sheets("Blad2").Range("A2:A" & Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Row)
   gevonden = 0
   Set c = Sheets("Blad1").Range("A:a").Find(cl, LookIn:=xlValues)
    If Not c Is Nothing Then
      gevonden = 1
       With Sheets("Blad2")
         If .Range("A" & cl.Row) <> Sheets("Blad1").Range("A" & c.Row) Then cl.Copy Sheets("Blad1").Range("A" & c.Row): Sheets("Blad1").Range("A" & c.Row).Interior.ColorIndex = 3
         If .Range("B" & cl.Row) <> Sheets("Blad1").Range("B" & c.Row) Then cl.Offset(, 1).Copy Sheets("Blad1").Range("B" & c.Row): Sheets("Blad1").Range("B" & c.Row).Interior.ColorIndex = 3
         If .Range("C" & cl.Row) <> Sheets("Blad1").Range("C" & c.Row) Then cl.Offset(, 2).Copy Sheets("Blad1").Range("C" & c.Row): Sheets("Blad1").Range("C" & c.Row).Interior.ColorIndex = 3
         If .Range("D" & cl.Row) <> Sheets("Blad1").Range("D" & c.Row) Then cl.Offset(, 3).Copy Sheets("Blad1").Range("D" & c.Row): Sheets("Blad1").Range("D" & c.Row).Interior.ColorIndex = 3
         If .Range("E" & cl.Row) <> Sheets("Blad1").Range("E" & c.Row) Then cl.Offset(, 4).Copy Sheets("Blad1").Range("E" & c.Row): Sheets("Blad1").Range("E" & c.Row).Interior.ColorIndex = 3
         If .Range("F" & cl.Row) <> Sheets("Blad1").Range("F" & c.Row) Then cl.Offset(, 5).Copy Sheets("Blad1").Range("F" & c.Row): Sheets("Blad1").Range("F" & c.Row).Interior.ColorIndex = 3
         If .Range("G" & cl.Row) <> Sheets("Blad1").Range("G" & c.Row) Then cl.Offset(, 6).Copy Sheets("Blad1").Range("G" & c.Row): Sheets("Blad1").Range("G" & c.Row).Interior.ColorIndex = 3
         If .Range("H" & cl.Row) <> Sheets("Blad1").Range("H" & c.Row) Then cl.Offset(, 7).Copy Sheets("Blad1").Range("H" & c.Row): Sheets("Blad1").Range("H" & c.Row).Interior.ColorIndex = 3
         If .Range("I" & cl.Row) <> Sheets("Blad1").Range("I" & c.Row) Then cl.Offset(, 8).Copy Sheets("Blad1").Range("I" & c.Row): Sheets("Blad1").Range("I" & c.Row).Interior.ColorIndex = 3
         If .Range("J" & cl.Row) <> Sheets("Blad1").Range("J" & c.Row) Then cl.Offset(, 9).Copy Sheets("Blad1").Range("J" & c.Row): Sheets("Blad1").Range("J" & c.Row).Interior.ColorIndex = 3
         If .Range("K" & cl.Row) <> Sheets("Blad1").Range("K" & c.Row) Then cl.Offset(, 10).Copy Sheets("Blad1").Range("K" & c.Row): Sheets("Blad1").Range("K" & c.Row).Interior.ColorIndex = 3
         If .Range("L" & cl.Row) <> Sheets("Blad1").Range("L" & c.Row) Then cl.Offset(, 11).Copy Sheets("Blad1").Range("L" & c.Row): Sheets("Blad1").Range("L" & c.Row).Interior.ColorIndex = 3
         If .Range("M" & cl.Row) <> Sheets("Blad1").Range("M" & c.Row) Then cl.Offset(, 12).Copy Sheets("Blad1").Range("M" & c.Row): Sheets("Blad1").Range("M" & c.Row).Interior.ColorIndex = 3
       End With
    End If
  If gevonden = 0 Then
    With cl.Resize(, 13)
        .Copy Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row + 1)
            Sheets("Blad1").Range("A" & Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Row).Resize(, 13).Interior.ColorIndex = 6
    End With
  End If
Next
End Sub
Klik om te vergroten...

Nogmaals bedankt voor je oplossingen en je geduld.:thumb:
 
Laatst bewerkt:
Cobbe zei:
Hier is de code voor kolom A tot en met kolom M :
Het hoeft niet de laatste vraag te zijn maar soms is het frustrerend omdat de vraagstelling niet duidelijk/correct is.
En dit is zeker niet persoonlijk bedoeld.:thumb:
Klik om te vergroten...

Ik durf het bijna niet te vragen :confused: ik ben sinds je reactie bezig om hem draaiende te krijgen maar ik krijg telkens een mismatch error:confused:.
Als ik het debug krijg ik dit stukje gemarkeerd error.jpg

:o
 
Je moet geen schrik hebben om te vragen, we zijn toch vrij om te antwoorden of niet.:p

Maar nu wordt ie moeilijk.

Is uw blad soms beveiligd, loopt het bereik wel tot kolom I, .....??????

Activeer Blad1 en open dan de VBA-code.
Zet uw cursor aan het begin ( sub cobbe() )
en druk nu F8 en nog eens en nog eens , enz en zie wat er gebeurt, misschien kom je er zo al achter waar het scheefloopt.

Anders laat je het nog maar eens weten, hé.
 
Cobbe zei:
Je moet geen schrik hebben om te vragen, we zijn toch vrij om te antwoorden of niet.:p

Maar nu wordt ie moeilijk.

Is uw blad soms beveiligd, loopt het bereik wel tot kolom I, .....??????

Activeer Blad1 en open dan de VBA-code.
Zet uw cursor aan het begin ( sub cobbe() )
en druk nu F8 en nog eens en nog eens , enz en zie wat er gebeurt, misschien kom je er zo al achter waar het scheefloopt.

Anders laat je het nog maar eens weten, hé.
Klik om te vergroten...

Me bereik in beide tabbladen loopt tot en met M (rechts van M staat niks).
Ik heb je aanwijzingen gevolgd maar ik krijg alsnog een mismatch bij het runnen en dezelfde markering als op de afbeelding.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan