Kopieren gefilterde range + toevoegen formule

[dprod]

Beste mede forumleden,

Ik zit met een erg lastige vraag, waar ik na uren zoeken op internet nog niet uit ben gekomen.
Ik weet dat het gebruikelijk is een bestand mee te sturen, alleen in de macro zitten verwijzingen naar andere xls sheets waar in gezocht wordt naar prijzen ed.
Deze kan ik niet allemaal mee sturen, gezien het feit dat ik dit niet zomaar kan posten.

Ik wil het volgende bereiken (en is me deels gelukt)
Uit blad 1 een gefilterd bereik kopieren naar -> blad 2 (gelukt, zie macro code)
Op blad 2 worden deze regels "tussengoevoegd", er zijn dus bovenliggende en onderliggende gevulde regels. (gelukt)
Nu wil ik achter de "tussengevoegde" regels in kolom O & P een formule plakken (dezelde als de eerst bovenliggende regel).
Dit lukt mij dus niet.

In stappen gebeurt dus het volgende:
1. een gefilterd bereik word gekopieerd op blad 1
2. dit bereik wordt op de juiste plaats op blad 2 tussengevoegd
3. achter de tussengevoegde regels moet de eerst bovenstaande regel met prijs/formule gekopieerd/geplakt worden.

(de tussengevoegde regels zijn namelijk projectonderdelen van de eerst bovenstaande regel op blad 2, waarbij dezelfde prijs gehanteerd moet worden, deze imput komt dus vanaf blad 1 waar alle projectonderdelen gespecificeerd staan).

voorbeeld:

BLAD 1 REGEL 1: HANS 95009995 8stuks 9.95
BLAD 1 REGEL 2: HANS 95009996 5stuks 5.95
BLAD 1 REGEL 3: HANS 95009997 9stuks 3.95
BLAD 1 REGEL 4: HANS 95009998 3stuks 1.95

BLAD 2 REGEL 1: HANS - 25stuks totaal [KOLOM O = prijs] [KOLOM P = formule]
BLAD 2 REGEL 2: <hier wordt in blad 1 gefilterd op HANS en alles van HANS "tussengevoegd"> [KOLOM O = prijs] [KOLOM P = formule] <<<--- deze prijs/formule moeten gekopieerd worden van de regel hierboven (in dit voorbeeld dus regel 1), achter alle regels die uit blad 1 gehaald worden.

Ik hoop dat het een beetje duidelijk is.
Mijn macro is als volgt:

Private Sub OK_Click()

With ActiveCell
.EntireRow.Select
ActiveCell.Offset(0, 7).ClearContents
With ActiveCell.Offset(0, 7)
    Select Case .Value
      Case Is = "0"
          .Interior.ColorIndex = 22
          .Font.ColorIndex = 22
      Case Is = "1"
          .Interior.ColorIndex = 22
      Case Is = "2"
          .Interior.ColorIndex = 35
          .Font.ColorIndex = 35
      Case Is = "3"
          .Interior.ColorIndex = 35
          .Font.ColorIndex = 35
      Case Is = "4"
          .Interior.ColorIndex = 22
      Case Is = "5"
          .Interior.ColorIndex = 22
      Case Else
          .Interior.ColorIndex = xlNone
    End Select
End With

ActiveCell.Offset(0, 9).ClearContents
ActiveCell.Offset(0, 9) = "-"
End With

Sheets("vracht").Select

With ActiveSheet
.AutoFilterMode = False
With Range("A8:DZ1000")
.AutoFilter
If Len(Me.groter.Value & Me.kleiner.Value & Me.streepje.Value & Me.maand1.Value & Me.maand2.Value & Me.dag1.Value & Me.dag2.Value & Me.jaar1.Value & Me.jaar2.Value) > 0 Then
.AutoFilter Field:=2, Criteria1:=Me.groter.Value + Me.maand1.Value + Me.streepje.Value + Me.dag1.Value + Me.streepje.Value + Me.jaar1.Value, _
Operator:=xlAnd, Criteria2:=Me.kleiner.Value + Me.maand2.Value + Me.streepje.Value + Me.dag2.Value + Me.streepje.Value + Me.jaar2.Value
End If
If Len(Me.chaufeur.Value) > 0 Then
.AutoFilter Field:=3, Criteria1:=Me.chaufeur.Value
End If

End With
End With

Dim rng As Range
Dim rng2 As Range

With ActiveSheet.AutoFilter.Range
 On Error Resume Next
   Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
       .SpecialCells(xlCellTypeVisible)
 On Error GoTo 0
End With
If rng2 Is Nothing Then
   MsgBox "Geen regels om te Kopi�ren"
Else
   Set rng = ActiveSheet.AutoFilter.Range
   rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Columns("A:M").Copy
      
   Workbooks("LOGISTIEK2.xls").Sheets("planning").Activate '<<-- LET OP VERANDER PAD/NAAM

ActiveCell.Offset(1, 0).Select

With ActiveCell
.EntireRow.Select
End With

    Selection.Insert Shift:=xlDown

End If
   Workbooks("LOGISTIEK2.xls").Sheets("vracht").Activate '<<-- LET OP VERANDER PAD/NAAM
   ActiveSheet.ShowAllData
   Workbooks("LOGISTIEK2.xls").Sheets("planning").Activate '<<-- LET OP VERANDER PAD/NAAM
   
   Unload Me
End Sub

Alvast bedankt..

Grtz, dProd

 

[dprod]

Het is op een andere manier al opgelost!