Regel kopiëren en invoegen boven total

Status
Niet open voor verdere reacties.
M

mB2017

Nieuwe gebruiker
Lid geworden
23 jul 2017
Berichten
4
Goedenavond,

Ik heb een Excel gemaakt waarin orders ingevoerd gaan worden. Elke order bestaat uit een aantal productregels en onderaan het totaal (zie bijgaand een voorbeeld). Nu wil ik dat gebruikers van de sheet zelf een nieuwe productregel toe kunnen voegen door middel van een macro. Deze nieuwe productregel moet komen boven de "totaalregel" en de bovenliggende productregel kopiëren.

Onderstaand hetgeen ik reeds gevonden heb om mijn probleem op te lossen:
- zoek regel Totaal 2017 op en voeg een nieuwe regel in:
Code: 
Sub invoegenenkopieren()
Dim Lst As Long, n As Long
Lst = Range("A" & Rows.Count).End(xlUp).Row
For n = Lst To 1 Step -1
    With Range("a" & n)
        If .Value = "Totaal 2017" Then
            .Offset(1).EntireRow.Insert
            .EntireRow.Insert           
        End If
    End With
Next n
End Sub

- Daarnaast heb ik een regel gevonden die een regel kopieert.
Code: 
.Range("a2:f2").Copy Range("a65536").End(xlUp).Offset(1, 0)
. Ik krijg het alleen niet voor elkaar om beide macro's samen te voegen en om het tweede macro het gekopieerde bereik in de nieuw gegenereerde regel te plaatsen. Kan iemand mij hiermee op de juiste weg helpen?

Met vriendelijke groet!
 

Bijlagen

  • Vraag Helpmij.xlsx
    8,2 KB · Weergaven: 30
Ik heb inmiddels een code gevonden die op basis van een "zoekwoord" een regel kan kopiëren en boven het zoekwoord kan invoegen. Het probleem dat zich nu voortdoet is dat er in mijn Excel ook gegevens boven en onder de tabel staan. Zodra ik het macro dus wil gebruiken voor de uitgebreide Excel zoekt het macro alleen nog maar het zoekwoord, maar worden er geen regels meer ingevoegd. Bijgaand een nieuw voorbeeldbestandje. Zit er ergens een regel in de code die ik aan kan passen zodat het wel werkt? Maakt het daarnaast nog wat uit als ik meer kopregels toe ga voegen (zodat er meer kolommen meegekopieerd moeten gaan worden)?

Code: 
Sub InsertRow()


Cells.Find(What:="Total 2017", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

Dim d As Integer
d = Range("A:A").End(xlDown).Row
Dim c As Range
For i = d To 1 Step -1
If Cells(i, 1).Value Like "Total 2017" Then

Dim Rng, n As Long, k As Long
Application.ScreenUpdating = False
Rng = InputBox("Enter number of rows required.")
If Rng = "" Then Exit Sub

Range(ActiveCell, ActiveCell.Offset(Val(Rng) - 1, 0)).EntireRow.Insert
'need To know how many formulas To copy down.
'Assumesfrom A over To last entry In row.

k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 256).End(xlToLeft).Column
Range(Cells(k, 1), Cells(k + Val(Rng), n)).FillDown


End If
Next
End Sub
 

Bijlagen

  • test.xlsm
    22,8 KB · Weergaven: 27
Waarom gebruik je geen 'intelligente' tabel ?
 

Bijlagen

  • __effe serieus.xlsx
    10,1 KB · Weergaven: 33
Laatst bewerkt:
dank voor je reactie. De reden hiervoor is dat ik zeer weinig afweet van VBA en daarmee samenhangende functies. Mijn online zoektocht leidde me naar de laatste code die m.i. goed bruikbaar is en die ik zelf enigszins kan verklaren.

Nav je berichtje heb ik een tabel ingesteld op mijn bereik en vervolgens het macro uit mijn 2e berichtje toegevoegd (maar dan zonder de 2e alinea). Dit blijkt precies te werken zoals ik wil. Alleen de totalisering wordt onderaan de tabel wordt niet bijgewerkt met de nieuw ingevulde gegevens. Heb je daar een idee voor?
 
Om een rij aan de tabel, in het bestand van snb, toe te voegen is dit voldoende.

Code: 
Sub VenA()
  Sheets("Werkt goed").ListObjects(1).ListRows.Add
End Sub
 
Heren/dames,

Bedankt voor de tips en opties. Ik kies voor de oplossing uit mijn tweede post (maar dan wel aangevuld met de tabel-tip van snb). Dit werkt voor mij op dit moment het beste. In de nabije toekomst ga ik de code wat vereenvoudigen m.b.v. jullie tips.

Mvgr.,
mB2017
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan