exceldata van blad 1 archiveren in kolommen op blad 2 mbv vba

[werwer1]

Hallo,

In mijn vba-code heb ik het voor elkaar om een veld in blad 1 (j11) elke keer met 1 te verhogen en dat in blad 2 te archiveren in kolom 2 op de eerstvolgende lege regel. Tot zover prima.
Nu wil ik dit afhankelijk maken van een notatie in een andere cel waarin kan staan een 1, 2, of 3. Dus als er een 1 staat dan archiveren in kolom 2 maar als er een 2 staat dan archiveren in een nieuwe kolom (4) maar dan zo dat dan ook daar weer boven in de kolom wordt begonnen, dus de eerstvolgende lege cel in die kolom.

Sub Punt_bijtellen_en_archiveren()

'If Range("i2") = "1" Then
Range("j11").Select
ActiveCell.Value = ActiveCell.Value + 1
With Sheets("Blad 2")
rij = .Range("A1").CurrentRegion.Rows.Count + 1
.Cells(rij, 2) = [j11]
End With

'ElseIf Range("i2") = "2" Then
Range("j11").Select
ActiveCell.Value = ActiveCell.Value + 1
With Sheets("Blad 2")
rij = .Range("A1").CurrentRegion.Rows.Count + 1
.Cells(rij, 4) = [j11]
End With

'ElseIf Range("i2") = "3" Then
Range("j11").Select
ActiveCell.Value = ActiveCell.Value + 1
With Sheets("Blad 2")
rij = .Range("A1").CurrentRegion.Rows.Count + 1
.Cells(rij, 6) = [j11]
End With
'End if
End Sub

Zonder de regels met een ' werkt het wel voor één kolom. maar de regels met een ' aangegeven werken niet voor de 2e en 3e kolom.
In VBA moet natuurlijk de ' verwijderd worden, daar ben ik mee bekend.
Waar zit mijn (denk)fout?
Vriendelijke groet,
Richard

 

[VenA]

Zoiets misschien?

Sub VenA()
With Sheets(1)
    .[J11] = .[J11] + 1
    Sheets(2).Cells(Rows.Count, 1).Offset(, (.[I2] * 2) - 1).End(xlUp).Offset(1) = .[J11]
End With
End Sub

 

[werwer1]

Geweldig VenA.

Helemaal top. Waar ik meer zo'n 20 regels voor nodig heb kan dus 2. Dat is pas vooruitgang. Bedankt hiervoor.

Klein vraagje nog:
Als ik het één kolom rechts ervan wil hebben. Wat is daar dan nog voor nodig?
Ik dacht zelf om de (- 1) te verwijderen maar dat is het niet.
Sheets(2).Cells(Rows.Count, 1).Offset(, (.[I2] * 2) - 1).End(xlUp).Offset(1) = .[J11]
Vriendelijke groet,

 

[HSV]

Dit bedoel je?

Sheets(2).Cells(Rows.Count, 1).Offset(, .[I2]).End(xlUp).Offset(1) = .[J11]

 

[VenA]

Als je de -1 verwijderd gaat het toch echt één kolom naar rechts. Dus vertel ons even wat er nu daadwerkelijk moet gebeuren.

Beginnen in Kolom B en vervolgens twee kolommen overslaan? Dan wordt het

Sheets(2).Cells(Rows.Count, 2).Offset(, (.[I2] - 1) * 3).End(xlUp).Offset(1) = .[J11]

Maar het blijft een beetje gokken zo.

 

[werwer1]

Ik ben er uit. Wat bij mij dwars zat was een samengevoegde cel boven de kolommen waar de data onder moet komen.
Enorm bedankt voor de support.

 

[VenA]

Graag gedaan en goed dat je zelf ondervonden hebt dat samengevoegde cellen en VBA geen vrienden van elkaar zijn:thumb: