Via macro gegevens kopieren

[ir19]

Goedemorgen,

Ik ben bezig met een macro waarmee ik gegevens met een variabele lengte kopieer uit blad X. Deze moeten geplakt worden in blad Y.

Ik heb de volgende code tot nu toe (hierin is vast en zeker verbetering mogelijk) maar er zijn ook een aantal punten die ik niet voor elkaar krijg:

- Nu moet blad X open staan als de macro gedraaid wordt, dit wil ik eigenlijk vanaf blad Y kunnen doen.
- Daarnaast wil ik de waardes uit blad X 2x onder elkaar plakken. Dit moet lukken wanneer ik het plakken doe in de eerste lege cel.

Sub Testblad()

'Veld wordt leeg gemaakt en opmaak verwijderd
        Dim opmk As Range
        On Error Resume Next
        Set opmk = Po.Columns("A:Z")
        opmk.Clear
        Application.ScreenUpdating = True
        
        
'Zoekt laatste waarde in kolom A voor het kopiëren
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

 With Sheets("BladX")
    .Range("A3:A" & LastRow).Copy
    Worksheets("BladY").Range("E10").PasteSpecial Paste:=xlValues            '  .Range(Rows.Count, 1).End(xlUp).Offset (1)
   
   End With



'verwijderd regel met 88 en 90
Dim i As Long
        With Worksheets("BladY")
        For i = 100000 To 1 Step -1
        If .Cells(i, "E") = "88" Then
        .Cells(i, "E").EntireRow.Delete
End If
Next i
End With
        With Worksheets("BladY")
        For i = 100000 To 1 Step -1
        If .Cells(i, "E") = "90" Then
        .Cells(i, "E").EntireRow.Delete
End If
Next i
End With

Daarnaast zou ik graag het volgende willen:
Wanneer de gegevens voor de eerste keer geplakt worden wil ik graag in elke regel kolom D ''149100'' hebben staan. en in Kolom I een formule.
Bij de 2e selectie geplakt wordt wil ik graag in kolom D ''445005'' en weer in kolom I een formule.

Kan iemand mij helpen?

 

[emields]

Niet zonder voorbeeld bestand denk ik.

 

[ir19]

Voorbeeld

Hierbij een voorbeeld. Blad X heeft dus een variabel aantal getallen in kolom A deze moeten in blad Y in kolom E komen. 1x met 149100 in D en kolom I formule zoals weergeven. Vervolgens nogmaals met 445005 in D en formule zoals weergeven in I.

 

[VenA]

Zoiets?

Sub VenA()
  ar = Sheets("Blad X").Cells(3, 1).CurrentRegion.Resize(, 1)
  t = UBound(ar)
  ReDim ar1(1 To t * 2, 1)
  For j = 1 To t
    ar1(j, 0) = 149100
    ar1(j, 1) = ar(j, 1)
    ar1(j + t, 0) = 445005
    ar1(j + t, 1) = ar(j, 1)
  Next j
  With Sheets("Blad Y").Cells(10, 5)
    .Offset(, -1).Resize(t * 2, 2) = ar1
    .Offset(, 4).Resize(2 * t) = "=Jouw formule"
    .Offset(-1).CurrentRegion.AutoFilter 5, 88, xlOr, 90
    .CurrentRegion.EntireRow.Delete
    .AutoFilter
  End With
End Sub

 

[ir19]

Bijna! In blad X kopieert de macro nu cel A1 en A2 deze zijn leeg.
Het kopieren mag dus beginnen vanaf de eerste gevulde cel in A.

 

[VenA]

Dan zal het voorbeeldbestand niet hetzelfde zijn als het echte bestand en moet je de code even aanpassen.

 

[ir19]

Dat klopt in het orrigineel staan kopnamen in regel 1 en 2 boven de kolommen.