VBA verticaal kopieren en horizontaal plakken

[TWDR]

Beste Help MIJ - ers,

Ik heb op de Bron sheet een aantal gegevens staan welke ik wil kopiëren en plakken via VBA. Opzich niet zo spannend maar ik wil graag dat hij ze naast elkaar plakt ipv onder elkaar, waarbij telkens 1 kolom wordt overgeslagen.
Ik heb nu onderstaande code staan, maar ik krjig hem niet werkend. Ik heb nogal wat moeite het met juist invullen van de RANGE en de toepassing van Offset hierbij.
Hulp wordt zeer gewaardeerd :thumb::thumb:

Sub Kopieren_test()

Dim iLaatsteRij As Integer
    iLaatsteRij = ThisWorkbook.Sheets("Bron").Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To iLaatsteRij
    ThisWorkbook.Sheets("Bron").Range("D" & x & ":D" & x).Copy
    ThisWorkbook.Sheets("Output").Range("B2").End(xlUp).Offset(1, x).PasteSpecial
    Next x

End Sub

Een voorbeeldje van het bestand. De waarden van het bron bestand dienen te worden geplakt op de gele plekken - waarbij dus steeds 1 kolom wordt overgeslagen.

Bekijk bijlage test.xlsm

 

[VenA]

.Offset(1, (x - 2) * 2)

 

[TWDR]

Sick hij werkt Thanks!!!

 

[snb]

Sub M_snb()
    sn = Sheets("bron").Cells(1).CurrentRegion
    
    For j = 2 To UBound(sn)
       Sheets("output").Cells(2, 2 + 2 * (j - 2)).Resize(UBound(sn, 2)) = Application.Transpose(Application.Index(sn, j))
    Next
End Sub

 

[TWDR]

Thnx

 

[TWDR]

De code werkt top, alleen had ik geen rekening gehouden met het feit dat er meerdere rijden gekopieerd en geplakt moeten worden, waarbij telkens 1 kolom wordt overgeslagen. Ik heb van alles geprobeerd maar ik krijg hem niet werkend. Ik gebruik eigenlijk dezelfde code voor alle rijen maar hij pakt alleen de eerste 2 rijen.

Iemand een idee hoe ik dit voor alle 4 de rijen werkend krijg? Het aantal processen is flexibel, dus kan minder of meer worden. Dit is het laatste puzzelstukje van mijn bestandje. Hulp wordt zeer gewaardeerd :thumb:.

Ik gebruik deze code en pas deze aan voor de overige rijen, waarbij enkel de range wordt aangepast.

Dim iLaatsteRij As Integer

    'vind laatste rij
    iLaatsteRij = ThisWorkbook.Sheets("Mappen_Outlook").Cells(Rows.Count, 1).End(xlUp).Row
    
    For x = 2 To iLaatsteRij
    
    'kopieer submap 3 vanuit mappen naar SLA
    ThisWorkbook.Sheets("Mappen_Outlook").Range("D" & x & ":D" & x).Copy
    ThisWorkbook.Sheets("SLA").Range("B2").End(xlUp).Offset(1, (x - 2) * 2).PasteSpecial xlPasteValues

Bekijk bijlage test.xlsm

 

[VenA]

Wat is het nut van de lege kolommen? Leg ook even uit wat nu wat is. De kolomkoppen wijken nogal af met wat je in het resultaat laat zien.

 

[TWDR]

De hoofdsheet Werkvoorraad is de hoofdsheet waar per proces belangrijke info wordt getoond. (Ik zou hem graag hierop gooien maar hier staat nogal veel privacy gevoelige informatie op). Deze sheet is door de opdrachtgever gevuld met veel formules en verwijzingen. De werkvoorraad sheet is zo in elkaar gezet dat 1 proces 2 kolommen omvat, waarbij de kolom weer is onderverdeeld in delen met "2 cellen" en delen met "1 cel over de breedte van 2" - if that makes any sense.

Er zit een functie in de werkvoorraad sheet waarbij er een proces kan worden toegevoegd. Hierdoor worden de laatste 2 kolommen gekopieerd en ernaast geplakt. Het thema en de formules worden mooi meegeplakt. Maar omdat het proces bestaat uit 2 kolommen en deze waarden in 1 van de 2 staan, moet er steeds een kolom worden overslagen. Door het overslaan van de kolom wordt de formule "juist doorgetrokken" bij het invoegen van een kolom. Vandaar dus deze omslachtige methode. In de werkvoorraad wordt de informatie zoals hieronder onder elkaar weergegeven.

Naam Proces
Oudste datum
Totaal
Laatste dag binnen SLA
Buiten SLA

Het SLA bestand wordt gebruikt als tussensheet. Per proces moeten hier respectievelijk: Proces, Oudste datum, Totaal Aantal, op SLA, Aantal buiten SLA in komen te staan. In de mappen_outlook sheet staan deze naast elkaar per proces. Deze wil ik graag in het SLA bestand onderelkaar hebben, waarbij dus steeds 1 kolom wordt overgeslagen. Ik krijg het alleen niet voor elkaar .

Ik zie dat ik idd de kolomnamen niet duidelijk had neergezet. Ik heb het bestandje aangepast waarbij dus eigenlijk alle informatie over Proces 1 - in volgorde onder elkaar dient te komen te staan in het SLA bestand.

Proces 1
Proces 1.1
Proces 1.2
Proces 1.3
Proces 1.4

Bekijk bijlage test_kopieren.xlsm

 

[TWDR]

Ik zie dat ik alsnog de kolomkoppen en nummers enzo door de war haal hierboven in mijn post. Dat krijg je als je te lang in zo'n bestand zit te klooien .
Ik dacht zojuist dat ik de oplossing had gevonden, maar nu werkt hij toch niet meer........

De kolomkoppen staan nu goed. Het is eigenlijk gewoon de bedoeling dat de gegevens netjes onder elkaar komen te staan op deze volgorde. Waarbij dus steeds een kolom wordt overgeslagen. Hoop dat het zo iets duidelijker is. :thumb:

Proces 1
Proces 1.1
Proces 1.2
Proces 1.3
Proces 1.4

 

[HSV]

Zo?

Sub M_snb_hsv()
    sn = Sheets(1).Cells(1).CurrentRegion
    
    For j = 2 To UBound(sn)
       Sheets(2).Cells(20, 2 + 2 * (j - 2)).Resize(UBound(sn, 2) - 2) = Application.Transpose(Application.Index(sn, j, Array(4, 7, 6, 5, 9, 8, 6, 10)))
    Next
End Sub