• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Meerdere macro's tegelijk

Status
Niet open voor verdere reacties.
H

HansVV

Gebruiker
Lid geworden
10 mei 2016
Berichten
11
Beste Excel guru,

Ik heb 2 macro's in 1 excel document:

Sub Omzet()
With ActiveSheet
Rows("40:40").Select
Selection.Copy
Sheets("DATAom").Select
Range("A65535").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False



End With

'
End Sub



en:



Sub Pipeline()
With ActiveSheet
Rows("42:42").Select
Selection.Copy
Sheets("DATApl").Select
Range("A65535").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False



End With

'
End Sub



De bedoeling is dat ik deze 2 macro's samenvoeg in 1 macro. Op internet diverse (mogelijke) oplossingen gevonden maar er is er tot nu toe geen een die werkt.
Nu ik alle amateurs heb gehad kom ik bij jullie. Wie weet hoe ik deze 2 seperate macro's kan samenvoegen tot 1?

Alvast bedankt voor je reactie!!

Gr. Hans
 
Het simpelste is om net voor je "End Sub" van de eerste procedure dit regeltje te plaatsen: Call Pipeline

Dan wordt de tweede procedure vanzelf meegenomen. ;)
 
Ginger zei:
Het simpelste is om net voor je "End Sub" van de eerste procedure dit regeltje te plaatsen: Call Pipeline

Dan wordt de tweede procedure vanzelf meegenomen. ;)
Klik om te vergroten...

Bedankt voor je reactie!
Als ik dit doe wordt de eerste (origibele) macro wel uitgevoerd maar de 2e niet...
Dit is de code:

Sub Omzet()
With ActiveSheet
Rows("40:40").Select
Selection.Copy
Sheets("DATAom").Select
Range("A65535").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False



End With

'
Call Pipeline
End Sub
 
Als ze bij elkaar in dezelfde module of sectie staan zou wat Ginger zou gewoon moeten werken.
Maar probeer het eens zo:
Code: 
Sub Omzet()
    Application.ScreenUpdating = False
    With ActiveSheet
        [COLOR="#008000"]'Omzet[/COLOR]
        Rows("40:40").Select
        Selection.Copy
        Sheets("DATAom").Select
        Range("A65535").End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        
        [COLOR="#008000"]'Pipeline[/COLOR]
        Rows("42:42").Select
        Selection.Copy
        Sheets("DATApl").Select
        Range("A65535").End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
    End With
    Application.ScreenUpdating = True
End Sub
 
Laatst bewerkt:
edmoor zei:
Als ze bij elkaar in dezelfde module of sectie staan zou wat Ginger zou gewoon moeten werken.
Maar probeer het eens zo:
Code: 
Sub Omzet()
    Application.ScreenUpdating = False
    With ActiveSheet
        [COLOR="#008000"]'Omzet[/COLOR]
        Rows("40:40").Select
        Selection.Copy
        Sheets("DATAom").Select
        Range("A65535").End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        
        [COLOR="#008000"]'Pipeline[/COLOR]
        Rows("42:42").Select
        Selection.Copy
        Sheets("DATApl").Select
        Range("A65535").End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
    End With
    Application.ScreenUpdating = True
End Sub
Klik om te vergroten...


Nog steeds wordt alleen de eerste macro correct uitgevoerd...:-(
 
Het is maar 1 macro nu dus je kan over een eerste of een tweede niet spreken. Laat maar eens je document zien.
Daarnaast zou dit moeten voldoen:
Code: 
Sub Omzet()
    Dim LR As Long
    With ActiveSheet
        [COLOR="#008000"]'Omzet[/COLOR]
        LR = Sheets("DATAom").Range("A65535").End(xlUp).Offset(1, 0).Row
        Sheets("DATAom").Rows(LR) = .Rows(40).Value
        
        [COLOR="#008000"]'Pipeline[/COLOR]
        LR = Sheets("DATApl").Range("A65535").End(xlUp).Offset(1, 0).Row
        Sheets("DATApl").Rows(LR) = .Rows(42).Value
    End With
End Sub
 
Laatst bewerkt:
Dat is iets voor een moderator, daar kan ik niks over zeggen.
 
Ginger en edmoor, bedankt voor jullie reactie en effort! Als ik weet hoe ik het document hier kan plaatsten doe ik dat gelijk.

Moderator? :)
 
Volgens mij gaat het zo ook wel goed.

Code: 
Sub VenA()
With Sheets("DATApl")
    Sheet1.Range("40:40,42:42").Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
End With
End Sub

Als code vanaf de activesheet wordt uitgevoerd dan kan je dat net zo goed weglaten. Sheet1 (kan ook als Blad1, Sheets(1), Sheets("Blad1"), etc geschreven worden Is een beetje taal afhankelijk). Dan ben je niet afhankelijk vanaf welke plek je de code aanroept.
 
Laatst bewerkt:
HansVV zei:
Moderator? :)
Klik om te vergroten...

Iemand die de boel hier beheert ;)
Ik heb overigens geen enkel probleem met het uploaden van een Excel document.

@VenA:
Het zijn 2 verschillende target sheets.
 
@edmoor, Wanneer zijn er weer actie weken bij Pearl. ff niet gezien:shocked: Het lijkt mij dat de TS een copy wil dus incluis opmaak of wat dan ook.

Code: 
Sub VenA()
With Sheets("DATApl")
    Sheet1.Rows(40).Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
End With
With Sheets("DATAom")
    Sheet1.Rows(42).Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
End With
End Sub

En dan net andersom waarschijnlijk.:d
 
VenA zei:
@edmoor, Wanneer zijn er weer actie weken bij Pearl. ff niet gezien:shocked:
Klik om te vergroten...
Geen idee. Aan mijn omvang te zien ben ik meer een Speksaver :p
 
Zeer verstandig om wat omvang op te bouwen voor de bizarre winters hier.:cool:

Laten we het draadje maar teruggeven aan de TS. Anders wordt het helemaal een onleesbaar zooitje.:)
 
HansVV zei:
Als ik dit doe wordt de eerste (origibele) macro wel uitgevoerd maar de 2e niet...
Klik om te vergroten...
Dat lijkt mij sterk! Klik 'ns met de muis in de tweede procedure in de kantlijn van de regel "With ActiveSheet". Je ziet dan een grote donkerrode punt verschijnen. Start dan procedure 1 'ns op. Als het goed is, moet je code dan stoppen bij die rode punt. Doorloop je code dan 'ns regel voor regel met F8 in de VBE. Zo kan je precies zien wat er in je sheet aan 't gebeuren is (of niet natuurlijk).

[EDIT] Met dank aan Haije die een behoorlijke storende typo opmerkte! Bij deze rechtgezet.
 
Laatst bewerkt:
@Ginger: regel voor regel een macro doorlopen gaat toch met F8???
 
edmoor zei:
Het is maar 1 macro nu dus je kan over een eerste of een tweede niet spreken. Laat maar eens je document zien.
Daarnaast zou dit moeten voldoen:
Code: 
Sub Omzet()
    Dim LR As Long
    With ActiveSheet
        [COLOR="#008000"]'Omzet[/COLOR]
        LR = Sheets("DATAom").Range("A65535").End(xlUp).Offset(1, 0).Row
        Sheets("DATAom").Rows(LR) = .Rows(40).Value
        
        [COLOR="#008000"]'Pipeline[/COLOR]
        LR = Sheets("DATApl").Range("A65535").End(xlUp).Offset(1, 0).Row
        Sheets("DATApl").Rows(LR) = .Rows(42).Value
    End With
End Sub
Klik om te vergroten...

Hoi edmoor,

Bijgaand het document waar het om gaat. Ik kon hem niet uploaden omdat het bestand te groot was. Het gaat om 52 weken, ik heb week 2 t/m 52 verwijderd zodat het bestand niet te groot is. Beide macro's die 1 moeten worden staan er nog wel in.

Hoop dat jij of iemand anders me kan helpen.
 

Bijlagen

  • Sales DashBoardTEST VERSIE.xlsm
    86,1 KB · Weergaven: 46
Doe alle macro's(modules) weg en vervang door deze:
Code: 
Sub Omzet()
 With ActiveSheet
  .Rows("40:40").Copy Sheets("DATAom").Range("A65535").End(xlUp).Offset(1, 0)
 End With
  Pipeline
End Sub
Sub Pipeline()
 With ActiveSheet
  .Rows("42:42").Copy Sheets("DATApl").Range("A65535").End(xlUp).Offset(1, 0)
 End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan