Gegevens kolommen overzetten naar ander tabblad met VBA

[Matjes]

In Excel heb ik een eerste tabblad met vaste kolomindeling welke niet gewijzigd mag worden i.v.m. inlezen van de gegevens in een ander programma. In dit tabblad worden basisgegevens ingevuld en gemuteerd.

Ik wil echter kolommen tussen - en toevoegen met extra gegevens aan de basisgegevens. Dit zou ik dan willen doen op een tweede tabblad. De basis gegevens uit het eerste tabblad wil ik dan met VBA overzetten naar specifieke kolommen in het tweede tabblad zodat de extra gegevens hieromheen gezet kunnen worden.

Bijvoorbeeld, eerste tabblad gegevens uit kolom A, B, C moeten naar het tweede tabblad kolom B, E, G. Omdat het een groot aantal rijen betreft welke kunnen variëren wil ik dit niet met verwijzingen doen maar bij voorkeur met VBA.

Kan iemand mij op weg helpen met een stukje VBA code?

Onderstaand een voorbeeld van het Excel bestand.

Bekijk bijlage Voorbeeld kolommen kopieren.xlsx

 

[SjonR]

Kan jij ons op weg helpen met een voorbeeldbestandje? :thumb:

 

[Matjes]

Hoi, ik heb een versimpeld voorbeeld van het Excel bestand in het originele bericht geplaatst :thumb:

 

[gast0660]

Zoiets?

 

[Matjes]

Bedankt voor het voorbeeld :thumb: Het overzetten werkt. Echter blijkt het toepassen van de lijst niet goed te werken. Als op bijvoorbeeld een van de lijsten van beide tabbladen anders gesorteerd of gefilterd wordt dan worden gegevens op de verkeerde plaats gezet wat natuurlijk logisch is. Is hier nog een eenvoudige oplossing voor te bedenken, bijvoorbeeld eerst alle filters en sorteringen terugzetten alvorens te kopiëren?

 

[HSV]

Private Sub CommandButton1_Click()
 sv = Cells(1).CurrentRegion
 For j = 1 To 3
  sq = Application.Index(sv, Evaluate("row(2:" & UBound(sv) & ")"), j)
    x = Choose(j, 2, 5, 7)
   Sheets("extra").Cells(2, x).Resize(UBound(sv)-1) = sq
 Next j
End Sub

 

[Matjes]

Harry bedankt voor je reactie. Deze code werkt ook :thumb: alleen wanneer de lijsten anders gesorteerd worden ontstaat er een probleem. Zie ook vorig bericht. Is dit nog eenvoudig op te lossen?

Zou je de code wellicht kunnen verklaren zodat ik de werking ook beter begrijp?

Alvast dank.

 

[HSV]

Je voorbeeldbestand is daarmee niet echt duidelijk.

Waarschijnlijk bedoel je dit.

Private Sub CommandButton1_Click()
With ListObjects(1)
   .ShowAutoFilter = False
   With .Range
    .Sort .Cells(1), , .Cells(1, 2), , , .Cells(1, 3), , xlYes
   End With
 sv = .DataBodyRange.Value
    For j = 1 To 3
      sq = Application.Index(sv, 0, j)
      x = Choose(j, 2, 5, 7)
      Sheets("extra").Cells(2, x).Resize(UBound(sv) - 1) = sq
    Next j
 .ShowAutoFilter = True
 End With
End Sub

 

[Matjes]

Harry hartelijk dank. Dat is precies de werking wat ik bedoelde. Ik heb je code in bijgaande Excel voorbeeld geplaatst. Ik zou graag nog een stapje verder willen. Nu worden de kolommen van het tabblad basis op volgorde naar tabblad extra gekopieerd. In het bijgevoegde Excel voorbeeld moeten er ook een aantal worden overgeslagen en in een andere volgorde naar tabblad extra worden gekopieerd. Na het kopiëren zou ik het eventuele actieve filter op tabblad extra automatisch opnieuw willen draaien met dezelfde instelling zodat nieuwe waarden ook direct zichtbaar zijn. Zou je mij hier nog bij kunnen helpen?


Alvast dank :thumb:

Bekijk bijlage kolommen kopieren.xlsm

 

[VenA]

Ook nu is jouw voorbeeld niet helder. Er staat geen enkel filter aan. Welke moeten worden overgeslagen? Moeten de nieuwe waarden aan de tabel toegevoegd worden of moeten de oude waarden overschreven worden? In welke andere volgorde moet er iets weggeschreven worden en waarom?

 

[Matjes]

Ik zou proberen wat meer duidelijkheid te geven.

De rijen/cellen welke in tabblad basis staan moeten naar tabblad extra worden gekopieerd op dezelfde rijnummer en onder de kolommen met dezelfde kolomnamen. De extra kolommen op tabblad extra worden dan gebruikt om extra informatie toe te voegen aan dezelfde rij. Zowel de lijst op de tabblad basis als extra kunnen ook gefilterd of gesorteerd worden. Dit mag geen invloed hebben op het kopiëren van de gegevens. De waarden moeten dus steeds overschreven worden.

Samengevat de lijsten moeten dus clonen van elkaar zijn hetzij in een andere kolom volgorde op tabblad extra en aantal extra tussengevoegde kolommen waaraan informatie aan de rijen kan worden toegevoegd. .

Ik hoop dat het zo duidelijker is.

 

[HSV]

Ik begrijp niet veel van de vraag.

Hier een ander kunstje.
Zorg dat de eerste 6 kolomkoppen van blad 'extra' dezelfde tekst bevat als blad basis.
Ze mogen door elkaar staan.

Private Sub CommandButton1_Click()
With ListObjects(1)
   .ShowAutoFilter = False
   With .Range
    .Sort .Cells(1), , .Cells(1, 2), , , .Cells(1, 3), , xlYes
   End With
 sv = .Range
 sq = Sheets("extra").Cells(1).CurrentRegion.Resize(, 7)
  With Application
    x = Split(Join(.Index(sq, 1, 0), "|"), "|")
    sv = .Index(sv, Evaluate("row(2:" & UBound(sv) & ")"), Filter(.IfError(.Match(x, .Index(sv, 1), 0), 0), 0, False))
  End With
      Sheets("extra").Cells(2, 1).Resize(UBound(sv) - 1, UBound(sv, 2)) = sv
    .ShowAutoFilter = True
 End With
End Sub

 

[Matjes]

Harry bedankt voor de aangepaste code :thumb: Laat ik het probleem omschrijven waardoor wellicht de vraag wat duidelijker wordt.

Probleem is dat ik de lijst op tabblad basis niet mag uitbreiden met kolommen. Dit i.v.m. het inlezen van de lijst in een ander systeem. Ik wil echter kolommen toevoegen om extra gegevens aan de rijen te kunnen toevoegen voor eigen gebruik. Hiertoe zou ik dus dezelfde lijst op tabblad extra willen zien waaraan ik dan zelf kolommen kan toevoegen zodat ik wel gegevens kan toevoegen aan de rijen. In principe kan ik dit gewoon met verwijzingen maken alleen ik weet nooit hoelang een lijst is. Dit vergt dan steeds een handmatige aanpassing (vandaar de voorkeur met VBA).


In onderstaand voorbeeld is het dan de bedoeling dat de gegevens uit tabblad basis naar extra worden gekopieerd onder de juiste kolommen en in de juiste rijen. De extra kolommen op tabblad extra (die dus niet op tabblad basis staan) zijn dan bedoeld om met de hand extra informatie aan de rijen te kunnen toevoegen.

Hopelijk is mijn vraagstelling wat duidelijker geworden

Bekijk bijlage kolommen kopieren.xlsm

 

[HSV]

Test het zo maar eens weer.

Private Sub CommandButton1_Click()
With ListObjects(1)
   .ShowAutoFilter = False
   With .Range
    .Sort .Cells(1), , .Cells(1, 2), , , .Cells(1, 3), , xlYes
   End With
 sv = .Range
 sv = .Range.Resize(, UBound(sv, 2) + 1)
 x = UBound(sv, 2)
    sv = Application.Index(sv, Evaluate("row(2:" & UBound(sv) & ")"), Array(10, x, 9, x, 2, x, 7))
      With Sheets("extra").ListObjects(1).DataBodyRange
        .ClearContents
        .Cells(1, 1).Resize(UBound(sv) - 1, UBound(sv, 2)) = sv
      End With
    .ShowAutoFilter = True
 End With
End Sub

 

[Matjes]

Dat is snel :thumb: Even getest. Het overzetten gaat goed echter moet de informatie (onder kolommen opm.) op tabblad extra niet worden gewist bij het overzetten van data. Deze wordt nu ook leeg gepoetst.

 

[HSV]

Ik heb de sortering er maar uitgehaald daar je niets mag veranderen.
De sortering op die gegevens werken toch niet goed.

Private Sub CommandButton1_Click()
With ListObjects(1)
   .ShowAutoFilter = False
 sv = .Range
 sv = .Range.Resize(, UBound(sv, 2) + 1)
 x = UBound(sv, 2)
    sv = Application.Index(sv, Evaluate("row(2:" & UBound(sv) & ")"), Array(10, x, 9, x, 2, x, 7))
      With Sheets("extra").ListObjects(1)
        sq = Array(.ListColumns(2).DataBodyRange.Value, .ListColumns(4).DataBodyRange.Value, .ListColumns(6).DataBodyRange.Value)
          .DataBodyRange.ClearContents
          .DataBodyRange.Cells(1, 1).Resize(UBound(sv) - 1, UBound(sv, 2)) = sv
        For j = 0 To 2
            y = y + 2
           .ListColumns(y).DataBodyRange.Value = sq(j)
         Next j
      End With
    .ShowAutoFilter = True
 End With
End Sub

 

[Matjes]

Harry bedankt voor de voorbeelden :thumb: Hiermee ga ik het wel werkend krijgen.