samengevoegde cellen splitsen en inhoud kopieren

[gjzijlstra]

Goedemorgen,

ik kom ergens niet uit en hoop dat iemand mij hiermee kan helpen. Ik heb een groot bestand waar verschillende cellen samengevoegd zijn, verspreid over het hele bestand. Ik wil die cellen uit elkaar hebben en de inhoud moet terug komen in elke cel zonder dat er kolommen bijkomen.

Ik heb een voorbeeldbestand bijgevoegd.

Bekijk bijlage voorbeeld.xlsx

Hoop dat iemand mij kan helpen!

Mvg,

Gerard

 

[Cobbe]

Deze zou dat moeten verwezenlijken:

Sub Cobbe()
For Each cl In Range("A1:D25")
    With cl
        .MergeCells = False
    End With
Next
End Sub

Wat dat bijvullen betreft kan dit beter handmatig gebeuren of via deze code:

Sub Cobbe()
For Each cl In Range("A1:D25")
    With cl
        .MergeCells = False
    End With
Next
Range("A2:A25").FillDown
Range("B2:B14").FillDown
Range("B15:B25").FillDown
Range("D2:D4").FillDown
Range("D5:D17").FillDown
Range("D18:D25").FillDown
End Sub

 

[ExcelAmateur]

gjzijlstra,

Ik weet niet of dit wat is.
Als je samengevoegde cellen heb en je klik daarop dan treed de macro in werking.

De code moet achter het blad waar de smengevoegde cellen staan.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  With ActiveWindow
    .ScrollRow = Target.Row
    .ScrollColumn = Target.Column
  End With
    H = Target.Address
    
  With Range(H)
    .MergeCells = False
  End With
    
    Range(H).FillDown
    Range(H).Select
  Lijnen
End Sub

Deze code in een Module, kan misschien wel wat korter.

Sub Lijnen()

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
  End With
  
  With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
  End With
  
  With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
  End With
  
  With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
  End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

End Sub

 

[gjzijlstra]

Dank voor jullie hulp,

Cobbe:
is er ook code dat bijvult bij elke cel die gesplitst wordt zonder dat vooraf de range wordt ingegeven?

Excelamateur:
Ik krijg je eerste code niet werkend. Ik heb het geplakt achter het blad, maar dan wordt het ook in de module gezet en hij vraagt een nieuwe macro te creeren.

Groet,

Gerard

 

[ExcelAmateur]

Probeer het met de file

 

[Cobbe]

Cobbe:
is er ook code dat bijvult bij elke cel die gesplitst wordt zonder dat vooraf de range wordt ingegeven?

Ja voor het Unmergen wel maar voor het bijvullen ???

Sub Cobbe()
For Each cl In Selection 'waarbij Selection nog dynamisch gemaakt kan worden
    With cl
        .MergeCells = False
    End With
Next
End Sub

 

[gjzijlstra]

ExcelAmateur: Het voorbeeld werkt het perfect! Hoe krijg ik hem nu ge-exporteerd naar mijn grote bestand?

Groet,

Gerard

 

[ExcelAmateur]

Kijk even in de VBA Editor, kun je zien wat ik gedaan heb.
Dan snap je ook van achter het blad en de Module.

Misschien dat iemand anders nog een betere code voor je heb, ik ben maar een amateur hierin.

 

[gjzijlstra]

Het werkt. Ik moet nu alleen elke cel apart aanklikken. Maar het gaat in ieder geval al een stuk sneller. Bedankt!

Groet,

Gerard