Regels koppelen aan cell

[Kev1983]

Ik heb een probleem met een excel file waar ik mee bezig ben.

Wat ik heb is:
Blad1 wordt ingevult door iemand. Kolom A t/m J worden gebruikt.
Ik wil kolom At/mD kopieren naar blad2. Hierna kan ik zelf informatie in de kolommen E t/m J invullen.
Als er een kolom op het eerste blad wordt verwijderd of toegevoegd dan moet deze op het 2de blad ook toegevoegd worden.
Dit lukt allemaal.

Het probleem is dat wanneer er een regel wordt toegevoegd dat de info in kolom E t/m J moeten meeverhuizen met de kolom A t/m D. Is dit mogelijk dat bijvoorbeeld de cellen E5 t/m J5 aan cell D5 gekoppeld worden. Dat als regel 4 verwijderd wordt (A4 t/m D4 worden dan verwijderd) dat dan E5 t/m J5 verplaats worden naar E4 t/m J4.

Wat ik nu heb is:

In VBA Dit kopieerd kolom A van blad1 naar blad2. Ook als er iets verwijderd wordt dan wordt dit meteen aangepast. Staat in VBA blad1.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
If Target.Column = 1 Then
LR = Me.Range("A" & Rows.Count).End(xlUp).Row
With Sheets("Blad2
.Columns("A").ClearContents
.Range("A1:A" & LR).Value = Me.Range("A1:A" & LR).Value
End With
End If
End Sub

In de kolommen B t/m D heb ik staan:

=ALS(ISFOUT(VERT.ZOEKEN($A5;Blad1!A:A:Blad1!B:B;2;ONWAAR)); ;VERT.ZOEKEN($A5;Blad1!A:A:Blad1!B:B;2;ONWAAR))

Alle waarden in kolom A zijn uniek. Dus ik kopieer de waarden van blad1 colom B t/m D naar blad 2. Op dezelfde plaats als ze staan op blad2.

Kan iemand mij helpen met het meeverplaatsen van de cellen D t/m J? Als je een andere oplossing heb dan wat ik nu al heb mag dat ook. Ik wil gewoon erg graag dat het gaat werken.

 

[WimenBeer]

Kan iemand mij helpen met het meeverplaatsen van de cellen D t/m J? Als je een andere oplossing heb dan wat ik nu al heb mag dat ook. Ik wil gewoon erg graag dat het gaat werken.

Tot zo ver begrijp ik wat je wilt doen, maar deze laatste zin snap ik niet.
In Bald2 staan alleen de cellen A:F gevuld, maar waar de waarde E en F vandaan komen begrijp ik niet. De kolommen G:J zijn helemaal niet gevuld.

Gaarne uitleg dan kunnen we je helpen (misschien)

Wim

 

[Kev1983]

Hier de bijlage hoe het wel is.
Ik kan het officiele bestand er niet opzetten omdat er wat vertrouwelijke informatie instaat.

Op blad2 vul ik zelf de kolomen E t/m J in. Maar deze moeten dus meeverplaatsen met kolom A.

Bedankt alvast

 

[WimenBeer]

Hier de bijlage hoe het wel is.
Ik kan het officiele bestand er niet opzetten omdat er wat vertrouwelijke informatie instaat.

Op blad2 vul ik zelf de kolomen E t/m J in. Maar deze moeten dus meeverplaatsen met kolom A.

Bedankt alvast

Ik begin het te snappen.
Het probleem zit hem niet in het toevoegen van een nieuwe regel in Blad1, maar juist in het verwijderen van een regel in Blad1.
Dan moeten alle waarden in Blad2 meeschuiven met het juiste nummer.

Klopt mijn aanname?

Wim

 

[Kev1983]

Klopt, maar ik heb het bijna werkend.

Maar bedankt in ieder geval.

 

[WimenBeer]

Klopt, maar ik heb het bijna werkend.

Maar bedankt in ieder geval.

Ter lering en vermaak, laat je de oplossing ook even weten voor het nageslacht.

Wim

 

[Kev1983]

heb het nu met arrays. Dankzij rorya van mrexcel.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long, LR2 As Long
Dim wks As Worksheet
Dim strFormula As String
On Error GoTo err_handle
strFormula = "=RC[1]&""|""&RC[2]&""|""&RC[3]&""|""&RC[4]"
If Target.Column = 1 Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wks = Sheets("Sheet2")
LR = Me.Range("A" & Rows.Count).End(xlUp).Row
LR2 = wks.Range("A" & wks.Rows.Count).End(xlUp).Row
Me.Columns(1).Insert
Me.Range("A3:A" & LR).FormulaR1C1 = strFormula
With wks
.Select
.Range("A:B").EntireColumn.Insert
.Range("B3:B" & LR2).FormulaR1C1 = strFormula
With .Range("A3:A" & LR2)
.FormulaR1C1 = "=MATCH(RC[1],'" & Me.Name & "'!R3C1:R" & LR & "C1,0)"
wks.Calculate
.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
End With
.Range("A:B").EntireColumn.Delete
End With
Me.Columns(1).Delete
End If