Transponeren van meerdere blokken met gegevens tegelijk

[hanskraan]

Ik zoek een oplossing voor het transponeren van in een tabblad bv "A" ingevoerde blokken met gegevens die verticaal onder elkaar staan en die in een ander tabblad "B" in de dezelfde verticale volgorde moeten komen te staan maar dan horizontaal naast elkaar.
Een bijlage verduidelijkt hopelijk mijn probleem.

Met de excel tools, kopieren en plakken of plakken speciaal of transponeren krijg je dit voor meerdere blokken tegelijk mijns inziens niet voor elkaar. Wie helpt mij aan een oplossing met de juiste formules welke dan in een (1) handeling in tabblad "B" geplaatst kunnen worden of met een VBA programma?
Bij voorbaat mijn dank

 

[Wigi]

Hans

Bevindt de lege rij zich telkens na 4 rijen gegevens? Zijn het telkens dezelfde 4 namen?

Wigi

 

[Wigi]

Gebruik bv.:

Sub copying()
Dim lRow As Long

Range("A" & 10).Resize(4, 1).Copy Worksheets("B").Range("IV2").End(xlToLeft)

For lRow = 10 To Range("B65536").End(xlUp).Row Step 5
    Range("B" & lRow).Resize(4, 1).Copy Worksheets("B").Range("IV2").End(xlToLeft).Offset(0, 1)
Next
End Sub

Is het naar wens?

Wigi

 

[hanskraan]

Hans

Bevindt de lege rij zich telkens na 4 rijen gegevens? Zijn het telkens dezelfde 4 namen?

Wigi

Hallo Wigi,
Ja, na elke 4 rijen is er een lege rij. Zie verder hierna.
Ja, de 4 namen zijn telkens dezelfde.

In feite is de lege rij niet echt leeg. In kolom A staat namelijk op de zogenaamde lege rij steeds de datum van de werkdag. Vervolgens worden de 4 gegevens behorend bij de 4 namen in kolom B van werkblad "A" elke werkdag ingevuld. De gegevens moeten dan automatisch blokgewijs in werkblad "B" naast elkaar worden afgebeeld. Boven elk blok verschijnt weer de datum. Dit is echter makkelijk in Excel te realiseren. Om het probleem niet te gecompliceerd te beschrijven, heb ik het gedoe met datum in eerste instantie niet opgenomen in de probleemstelling.
Het eerste blok begint ook niet in rij 10 maar in rij 2.

 

[Wigi]

Van 10 naar 2:

Sub copying()
Dim lRow As Long

Range("A" & 2).Resize(4, 1).Copy Worksheets("B").Range("IV2").End(xlToLeft)

For lRow = 2 To Range("B65536").End(xlUp).Row Step 5
    Range("B" & lRow).Resize(4, 1).Copy Worksheets("B").Range("IV2").End(xlToLeft).Offset(0, 1)
Next
End Sub

Werkt het?

Wigi

 

[hanskraan]

Van 10 naar 2:

Sub copying()
Dim lRow As Long

Range("A" & 2).Resize(4, 1).Copy Worksheets("B").Range("IV2").End(xlToLeft)

For lRow = 2 To Range("B65536").End(xlUp).Row Step 5
    Range("B" & lRow).Resize(4, 1).Copy Worksheets("B").Range("IV2").End(xlToLeft).Offset(0, 1)
Next
End Sub

Werkt het?

Wigi

Hallo Wigi
Helaas, er gebeurt helemaal niets. Alvorens de code naar de VBA editor te copieren heb ik de data (behalve de namen) in blad "B" verwijderd. Vervolgens heb ik de code gecopieerd naar VBA editor en opgeslagen in hetzelde bestand als het voorbeeld in de bijlage. In blad "B" worden de blokken met gegevens niet weergegeven. Ik doe waarschijnlijk in beginsel iets verkeerd maar weet niet wat.

 

[Wigi]

Hans

- open het bestand dat je bijvoegde.
- verwijder rijen zodat de gegevens op rij 2 beginnen
- verwijder getallen in blad B
- plak de code in een nieuwe Module in het juiste bestand
- kies Alt-F8 en voer de macro uit
- zou moeten gelukt zijn

Wigi

 

[hanskraan]

Hans

- open het bestand dat je bijvoegde.
- verwijder rijen zodat de gegevens op rij 2 beginnen
- verwijder getallen in blad B
- plak de code in een nieuwe Module in het juiste bestand
- kies Alt-F8 en voer de macro uit
- zou moeten gelukt zijn

Wigi

Hallo Wigi
Precies gedaan wat je instrueerde
We komen een stap verder, echter werken doet de macro nog niet.
Ik krijg de volgende foutmelding bij het uitvoeren:

Het subscript valt buiten het bereik

Bij de foutopsoring wordt de volgende regel geel gemarkeerd:

Range("A" & 2).Resize(4, 1).Copy Worksheets("B").Range("IV2").End(xlToLeft)

 

[Wigi]

Range("A" & 2).Resize(4, 1).Copy Worksheets("B").Range("IV2").End(xlToLeft)

Range("A" & 2) kan eigenlijk beter Range("A2") zijn, maar daar zal het niet aan liggen. Wat wel?

- Je hebt toch een werkblad "B"?
- Probeer eens de code stap voor stap uit te voeren (F8 drukken) waarbij je de vorige regel vervangen hebt door de deze:

Range("A" & 2).Resize(4, 1).Copy Range("K2")

Normaal gezien wordt er dan gekopieerd naar range K2 in het huidige tabblad. Laat weten wat het resultaat is.

Wigi

 

[hanskraan]

Range("A" & 2) kan eigenlijk beter Range("A2") zijn, maar daar zal het niet aan liggen. Wat wel?

- Je hebt toch een werkblad "B"?
- Probeer eens de code stap voor stap uit te voeren (F8 drukken) waarbij je de vorige regel vervangen hebt door de deze:

Range("A" & 2).Resize(4, 1).Copy Range("K2")

Normaal gezien wordt er dan gekopieerd naar range K2 in het huidige tabblad. Laat weten wat het resultaat is.

Wigi

Hallo Wigi
Ja, de namen worden naar cel K2 t/m K5 van blad "A" gecopieerd, maar bij de eerste next wordt wederom de reeds genoemde foutcode gegenereerd en stopt de uitvoering.
Bij het geheel uitvoeren van het programma wordt de navolgende regel geel gemarkeerd:

Range("B" & lRow).Resize(4, 1).Copy Worksheets("B").Range("IV2").End(xlToLeft).Offset(0, 1)

 

[Wigi]

Hans

open bijgevoegd bestand

Ga naar blad B. Daar staat niks.
Ga terug naar blad A. Druk Alt-F8 en voer de macro uit.
Ga dan naar blad B. Nu staat alles er zoals het hoort.
Kopieer de macro voor jouw bestand.

Lukt het?

Indien niet met jouw bestand en wel met het bijgevoegde, geef dan duidelijk aan wat de verschillen zijn tussen de bestanden, evt. voeg je het hier gezipt bij.

Wigi

 

[hanskraan]

Hans

open bijgevoegd bestand

Ga naar blad B. Daar staat niks.
Ga terug naar blad A. Druk Alt-F8 en voer de macro uit.
Ga dan naar blad B. Nu staat alles er zoals het hoort.
Kopieer de macro voor jouw bestand.

Lukt het?

Indien niet met jouw bestand en wel met het bijgevoegde, geef dan duidelijk aan wat de verschillen zijn tussen de bestanden, evt. voeg je het hier gezipt bij.

Wigi

Hallo Wigi
Ik begrijp er niets van. Met de files die jij mij gestuurd hebt, loopt het programma wel goed. De foutmelding verschijnt niet en de gegevens worden keurig in blad B gezet. Eigenlijk zou nu de opgave voltooid zijn, ware het niet dat er toch een schoonheids foutje in zit en wel deze:
Als je gegevens gaat toevoegen b.v. in de cel waar nu het woord enz staat en je voert het programma nogmaals uit, dan worden de namen in de cellen D2 t/m D5 herhaald. Ook de bijbehorende gegevens verschijnen dan in de kolommen E, F en G. Dit is nu niet de bedoeling. De bedoeling is dat de nieuwe gegevens in blad B worden toegevoegd zonder dat blad B eerst weer gewist moet worden. Zoals reeds eerder vermeld is, worden de cijfers bij de namen dagelijks toegevoegd. Ik neem aan dat dit een kleine aanpassing vergt aan de de code. Kun je die nog maken?
Groeten

 

[Wigi]

Gebruik dan

Sub copying()
Dim lRow As Long

Worksheets("B").Range("A2").CurrentRegion.ClearContents
Range("A" & 2).Resize(4, 1).Copy Worksheets("B").Range("A2")

For lRow = 2 To Range("B65536").End(xlUp).Row Step 5
    Range("B" & lRow).Resize(4, 1).Copy Worksheets("B").Range("IV2").End(xlToLeft).Offset(0, 1)
Next
End Sub

Wigi

 

[hanskraan]

Gebruik dan

Sub copying()
Dim lRow As Long

Worksheets("B").Range("A2").CurrentRegion.ClearContents
Range("A" & 2).Resize(4, 1).Copy Worksheets("B").Range("A2")

For lRow = 2 To Range("B65536").End(xlUp).Row Step 5
    Range("B" & lRow).Resize(4, 1).Copy Worksheets("B").Range("IV2").End(xlToLeft).Offset(0, 1)
Next
End Sub

Wigi

Hallo Wigi
Hoewel bovenstaand programma perfect werkt, is het toch nog niet helemaal goed bij grote hoeveelheid gegevens (>255 / naam). Als namelijk het aantal gegevens de 5 x 255 overschrijdt in werkblad A, met ander woorden er worden gegevens ingevoerd in cel B1276 en hoger, dan worden de gegevens in werkblad B vanaf kolom B weer overschreven. Dat is niet de bedoeling. De gegevens die na het vullen van kolom IV in werkblad B niet meer passen op dat werkblad, moeten in de volgende rijen komen te staan, dus in cellen B7, B8, B9 en B10. De namen komen weer vooraan te staan in de de cellen A7 t/m A10. Kun je nog een aanpassing in het programma maken?