Alleen gevulde rijen van divese tabbladen naar ander tabblad kopiëren

[albundy33]

Hallo,
zie bijgevoegd bestand.

Wat ik probeer voor elkaar te krijgen, is dat via de macro "rechthoek1_klikken",
vanuit het tabblad "serie 1", de cellen B28 t/m Z43 gekopieerd worden naar B3 op tabblad samenvatting,
maar dan alleen de gevulde cellen/rijen. Lege rijen moeten worden overgeslagen.
Vervolgens moet hetzelfde gedaan worden vanuit tabblad "serie 2", maar deze moeten dan niet naar B3 van "samenvatting" worden gekopieerd, maar in kolom B de 1e rij die leeg is, (omdat de bovenste rijen dan al gegevens van blad "serie 1" bevatten.)
Dit trucje moet dan ook nog voor "serie 3" en "serie 4" herhaald worden.

Ik heb echter een fout in de macro, waardoor het bij serie 1 al meteen fout gekopieerd wordt.
Wie kan helpen?

 

[VenA]

Tegen zoveel samengevoegde cellen is geen VBA-code opgewassen.

 

[albundy33]

Het probleem is, dat ik niet zou weten hou ik het formulier fatsoenlijk in elkaar zou krijgen zonder samengevoegde cellen. Het huidige geuploade bestand is slechts een kleine selectie van het achterliggende werkelijke bestand, waar nog 5x zoveel VBA-code achter zit. Ik kreeg regelmatig de terugkoppeling dat het niet mogelijk is met samengestelde cellen, maar er was telkens wel iemand die me kon helpen om het toch werkend te krijgen.

Ik ben inmiddels alweer een stukje verder met de code, heb het bestand dat ik heb toegevoegd aangepast. Het gaat nu nog mis bij het volgende, regels van serie 1 worden gekopieerd en geplakt. Echter dit zijn 3 regels. Het kopie uit "serie 2" moet dus op regel 4 worden geplakt (1e lege rij). De code dit nu echter op rij 3 omdat de selectie nog daar staat, en ik weet niet hoe ik dat weg krijg. Dan gaat het bij serie 3 helemaal mis, omdat hier geen enkele regel een invoer heeft, gaat hij een hele lap lege regels kopieren, terwijl hij eigenlijk "serie 3" eigenlijk dus had moeten negeren in dit geval, vanwege lege invoer.

 

[albundy33]

Ik heb inmiddels de macro als volgt :

Sub Rechthoek1_Klikken()

  Sheets("serie 1").Select
    Range("B28:AM28").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("samenvatting").Select
    Range("B3:E3").Select
    ActiveSheet.Paste
    Sheets("serie 2").Select
    Range("B28:AM28").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("samenvatting").Select
    [B]Range("B" & Rows.Count).End(xlUp).Offset(1).Select[/B]
    ActiveSheet.Paste
     Sheets("serie 3").Select
    Range("B28:AM28").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("samenvatting").Select
    Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveSheet.Paste
     Sheets("serie 4").Select
    Range("B28:AM28").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("samenvatting").Select
    Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveSheet.Paste
        
End Sub

Het stukje met de offset doet nu wat ik wil, naar de 1e lege regel springen.
Het enige probleem wat ik nu nog heb, is dat hij nog niet weet dat er in tabblad "serie 3 " niks te kopieëren valt, en dat hij deze dus verder moet laten voor wat het is.
Als iemand me daarmee kan helpen, is het probleem opgelost

 

[trainers]

Als iemand me daarmee kan helpen, is het probleem opgelost

Forget It!

Los van de vele "Selects" in je code (= niet doen) zijn samengevoegde cellen uitsluitend geschikt voor de Cosmetica (en zelfs dan zou ik ze zoveel mogelijk vermijden), niet om mee te rekenen of om binnen de VBA te gebruiken.
VenA memoreerde dit reeds.

Ik heb ze niet geteld, al die samengevoegde cellen. Moet een behoorlijk klusje zijn geweest.

Mijn advies: opnieuw opzetten.

Groeten

 

[albundy33]

Ik heb inmiddels zelf de oplossing gevonden, door het over een andere boeg te gooien, en alle benodigde rijen uit elk tabblad te kopiëren en plakken, en na elke plak actie, de lege rijen uit het veld te verwijderen. Werkt perfect.
Ik deel de code hier, zodat toekomstige hulpzoekers er misschien iets aan hebben.
Ik vind het wel jammer, dat mensen gelijk in krampachtige houdingen schieten als het over samengestelde cellen gaat.
Zoals al eerder aangegeven, het werkelijke bestand beschikt over nog veel meer samengestelde cellen, en er zit nog veel meer VBA-code overheen die daarmee werkt. Het is allemaal stukje voor stukje opgebouwd, en iedere keer kom je mensen tegen die meteen roepen : samengestelde cellen, gaat nooit werken.
Er zijn gelukkig ook mensen die wat verder durven denken, en wel met oplossingen komen. Ideaal is het misschien niet, maar soms heb je geen andere oplossing.
Hieronder de code met de oplossing, hoop dat anderen er nog iets aan hebben.

Sub Rechthoek1_Klikken()

  Sheets("serie 1").Select
    Range("B28:Z43").Select
    Selection.Copy
    Sheets("samenvatting").Select
    Range("B3:E3").Select
    ActiveSheet.Paste
    
    
  ActiveSheet.Range("B3:B18"). _
    SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 
On Error GoTo 0
 
    
    Sheets("serie 2").Select
    Range("B28:Z43").Select
    Selection.Copy
    Sheets("samenvatting").Select
    
    Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveSheet.Paste
    
    
  ActiveSheet.Range("B3:B18"). _
    SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    On Error GoTo 0
    
    Sheets("serie 3").Select
    Range("B28:Z43").Select
    Selection.Copy
    Sheets("samenvatting").Select
    Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveSheet.Paste
    
    
  ActiveSheet.Range("B3:B18"). _
    SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    On Error GoTo 0
    
    Sheets("serie 4").Select
    Range("B28:Z43").Select
    Selection.Copy
    Sheets("samenvatting").Select
    Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveSheet.Paste
       
  ActiveSheet.Range("B3:B18"). _
    SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    On Error GoTo 0
    
End Sub

 

[VenA]

Niks meer aan doen en de vraag nog even op opgelost zetten.:d