• 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.

2 regels naar beneden via Macro

Status
Niet open voor verdere reacties.
W

WIMLIN

Gebruiker
Lid geworden
17 jul 2007
Berichten
429
Ik heb netjes een printmacro opgenomen. Die werkt redelijk. Alleen wat ik zou willen weten hoe kan ik in de code een commando opnemen dat ik na de regel Selection.End(xlDown).Select een commando krijg dat ik na dit commando vanaf 2 regels lager altijd 500 regels invoeg?

Ik heb dit nu gedaan middels: Range("A11:A467").Select Maar dit werkt dat alleen éénmalig. Zodra de draaitabel een ander formaat heeft gaat het fout.


Code: 
Sub PRINTEN17742()
'
' PRINTEN17742 Macro
' PRINTEN 17742 DUB DEB
'

'
    Sheets("Voorblad").Select
    Range("B25").Select
    ActiveCell.FormulaR1C1 = "17742 B.U. BOTLEK"
    Sheets("Overzicht ").Select
    Range("A6").Select
    Selection.End(xlDown).Select
    Range("A11:A467").Select
    Selection.EntireRow.Insert
    Range("B7").Select
    ActiveSheet.PivotTables("Draaitabel10").PivotFields("B.U.").ClearAllFilters
    ActiveSheet.PivotTables("Draaitabel10").PivotFields("B.U.").CurrentPage = _
        "17742 B.U. BOTLEK"
    Range("A6").Select
    Selection.End(xlDown).Select
    Range("A66").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A66:A468").Select
    Selection.EntireRow.Delete
    Range("C66").Select
    ActiveSheet.PivotTables("Draaitabel13").PivotFields("B.U.").ClearAllFilters
    ActiveSheet.PivotTables("Draaitabel13").PivotFields("B.U.").CurrentPage = _
        "17742 B.U. BOTLEK"
    Range("B7").Select
    Sheets(Array("Voorblad", "Overzicht ")).Select
    Sheets("Overzicht ").Activate
    If Application.Dialogs(xlDialogPrinterSetup).Show Then
       ActiveWindow.SelectedSheets.PrintOut
    End If
    Sheets("PRINT MACRO'S").Select
    Application.Goto Reference:="R4C3"
End Sub
 
Code: 
   Selection.End(xlDown).Offset(2, 0).Select
    Range("A" & ActiveCell.Row & ":A" & ActiveCell.Row + 500).EntireRow.Insert

.Offset(2,0) zorgt ervoor dat je nog 2 regels extra naar beneden gaat.

Probeer wel zoveel mogelijk .select te vermijden.
Is meestal niet nodig en je verwerking wordt er een stuk zwaarder (=trager en onrustiger) door.

Code: 
    Range("B25").Select
    ActiveCell.FormulaR1C1 = "17742 B.U. BOTLEK"
kun je bijv. vervangen door
Code: 
    Range("B25").FormulaR1C1 = "17742 B.U. BOTLEK"
 
2 regel naar beneden

Goedemorgen Jan,

Dit commando werkt perfect. Na deze actie wordt vervolgens mijn eerste draaitabel ververst. Vervolgens ga ik via Selection.End(xlDown).Select weer naar mijn laatste rij en kan nu met nieuwe command gelijk ook 2 regels lager.

Wat ik nu niet weet hoe ik altijd de wit regels kan verwijderen van regel 2 na mijn draaitabel tot aan mijn volgende draaitabel.

Mogelijk kan u mij daar nog bij helpen.

Code: 
Sub PRINTEN17742()
'
' PRINTEN17742 Macro
' PRINTEN 17742 DUB DEB
'

'
    Sheets("Voorblad").Select
    Range("B25").Select
    ActiveCell.FormulaR1C1 = "17742 B.U. BOTLEK"
    Sheets("Overzicht ").Select
    Range("A6").Select
    Selection.End(xlDown).Offset(2, 0).Select
    Range("A" & ActiveCell.Row & ":A" & ActiveCell.Row + 500).EntireRow.Insert
    Range("B7").Select
    ActiveSheet.PivotTables("Draaitabel10").PivotFields("B.U.").ClearAllFilters
    ActiveSheet.PivotTables("Draaitabel10").PivotFields("B.U.").CurrentPage = _
        "17742 B.U. BOTLEK"
    Range("A6").Select
    Selection.End(xlDown).Select
    Range("A66").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A66:A468").Select
    Selection.EntireRow.Delete
    Range("C66").Select
    ActiveSheet.PivotTables("Draaitabel13").PivotFields("B.U.").ClearAllFilters
    ActiveSheet.PivotTables("Draaitabel13").PivotFields("B.U.").CurrentPage = _
        "17742 B.U. BOTLEK"
    Range("B7").Select
    Sheets(Array("Voorblad", "Overzicht ")).Select
    Sheets("Overzicht ").Activate
    If Application.Dialogs(xlDialogPrinterSetup).Show Then
       ActiveWindow.SelectedSheets.PrintOut
    End If
    Sheets("PRINT MACRO'S").Select
    Application.Goto Reference:="R4C3"
End Sub
 
Kun je deze niet selecteren en met .EntireRow.Delete verwijderen? Of ontgaat mij iets.

Netjes coderen maakt het lezen van een code voor een ander een stuk gemaakelijker. Mijn advies is om daar toch in te oefenen. Daarnaast is het gebruik van declaraties onontbeerlijk. Gebruik daarom altijd Option Explicit.

Zo zou je de code netjes schrijven:
Code: 
Option Explicit

Sub PRINTEN17742()
    Sheets("Voorblad").Select
    Range("B25").Select
    ActiveCell.FormulaR1C1 = "17742 B.U. BOTLEK"

    Sheets("Overzicht ").Range("A6").Select
    Selection.End(xlDown).Offset(2, 0).Select
    Range("A" & ActiveCell.Row & ":A" & ActiveCell.Row + 500).EntireRow.Insert

    Range("B7").Select
    With ActiveSheet.PivotTables("Draaitabel10").PivotFields("B.U.")
        .ClearAllFilters
        .CurrentPage = "17742 B.U. BOTLEK"
    End With

    Range("A6").Select
    Selection.End(xlDown).Select

    Range("A66").Select
    Range(Selection, Selection.End(xlDown)).Select

    Range("A66:A468").Select
    Selection.EntireRow.Delete

    Range("C66").Select
    With ActiveSheet.PivotTables("Draaitabel10").PivotFields("B.U.")
        .ClearAllFilters
        .CurrentPage = "17742 B.U. BOTLEK"
    End With

    Range("B7").Select
    Sheets(Array("Voorblad", "Overzicht ")).Select
    Sheets("Overzicht ").Activate

    If Application.Dialogs(xlDialogPrinterSetup).Show Then
       ActiveWindow.SelectedSheets.PrintOut
    End If

    Sheets("PRINT MACRO'S").Select
    Application.Goto Reference:="R4C3"
End Sub
 
Laatst bewerkt:
Ik was eens even bezig om de code te optimaliseren, maar ik stel me ineens een hele boel vragen bij de code.

Waarom selecteer je cellen en doe je er vervolgens niets mee? Op deze manier wordt het alleen maar trager. Ik weet natuurlijk niet wat er allemaal precies is gebeurd., maar als ik zo de code lees... "Vrij weinig voor zo veel code", maar dat kan hem aan mij liggen.

Code: 
Sub PRINTEN17742()
    Sheets("Voorblad").Range("B25").FormulaR1C1 = "17742 B.U. BOTLEK"

    Sheets("Overzicht ").Range("A6").Select           [COLOR="SeaGreen"]'         waarom niet Sheets("Overzicht").Range("A6:A8").Select??[/COLOR]
    Selection.End(xlDown).Offset(2, 0).Select
    Range("A" & ActiveCell.Row & ":A" & ActiveCell.Row + 500).EntireRow.Insert

    Range("B7").Select     [COLOR="SeaGreen"] '   Waarom?[/COLOR]                                
    With ActiveSheet.PivotTables("Draaitabel10").PivotFields("B.U.")     [COLOR="SeaGreen"]'<<<<   Sneller[/COLOR]
        .ClearAllFilters
        .CurrentPage = "17742 B.U. BOTLEK"
    End With

    Range("A6").Select                  [COLOR="SeaGreen"]'   waarom?[/COLOR]
    Selection.End(xlDown).Select       [COLOR="SeaGreen"] '   waarom?[/COLOR]

[COLOR="SeaGreen"]'    Range("A66").Select
'    Range(Selection, Selection.End(xlDown)).Select[/COLOR]
    Range("A66:A468").EntireRow.Delete [COLOR="SeaGreen"] '   <<<< Sneller[/COLOR]

    Range("C66").Select                 [COLOR="SeaGreen"]'   waarom?[/COLOR]
    With ActiveSheet.PivotTables("Draaitabel10").PivotFields("B.U.")    [COLOR="SeaGreen"]'   <<<< Sneller[/COLOR]
        .ClearAllFilters
        .CurrentPage = "17742 B.U. BOTLEK"
    End With

    Range("B7").Select                              [COLOR="SeaGreen"]'   waarom?[/COLOR]
    Sheets(Array("Voorblad", "Overzicht ")).Select
    Sheets("Overzicht ").Activate     [COLOR="SeaGreen"]'  Waarom?[/COLOR]

    If Application.Dialogs(xlDialogPrinterSetup).Show Then
       ActiveWindow.SelectedSheets.PrintOut
    End If

    Sheets("PRINT MACRO'S").Select                  [COLOR="SeaGreen"]'   waarom?[/COLOR]
    Application.Goto Reference:="R4C3"
End Sub


EDIT: Of heb je gebruik gemaakt van de macrorecoder?
 
Laatst bewerkt:
2 regel naar beneden

Allereerst Radjesh bedankt voor je hulp. Ik heb helaas gisteren geen tijd gehad om het te bekijken. Maar deze macro heb ik inderdaad gemaakt met opnemen.

In mijn bestand staan 2 draaitabellen onder elkaar. Daarom had ik bedacht 500 rijen in te voegen voordat de eerste draaitabel ververst wordt. Anders krijg ik regelmatig het probleem dat draaitabellen elkaar niet kunnen overlappen.

Maar vervolgens moet ik wel weer de rijen verwijderen tussen de twee draaitabellen.

Ik heb nu een voorbeeld van mijn bestand toegevoegd.

Doel bestand:20 pdf bestanden maken of 20 maal iets uitprinten

Ik heb 20 b.u.'s. Dit betekent 20 keer mijn twee draaitabellen verversen. Draaitabellen kunnen elkaar niet overlappen. Dus ik voeg steeds eerst wat regels toe. Die ik daarna als de draaitabel is ververs weer weggooi. Vervolgens selecteer ik het blad met de draaitabellen met het voorblad en print deze meestal in PDF formaat.

Code: 
Range("B7").Select      '   Waarom?
Omdat ik anders niet wist hoe ik onder mijn draaitabel kon komen.

Code: 
Range("B7").Select                              '   waarom?
    Sheets(Array("Voorblad", "Overzicht ")).Select
    Sheets("Overzicht ").Activate     '  Waarom?

Omdat ik in 1 keer deze twee werkbladen wil printen


Code: 
  Sheets("PRINT MACRO'S").Select                  '   waarom?
    Application.Goto Reference:="R4C3"
End Sub

In het tabllad Print Macro's. Heb ik allemaal buttons gemaakt waar ik dan heel snel alles kan pdfén.

Ik hoop dat het zo wat duidelijker is.
 

Bijlagen

  • Overzicht RESDUB P09-200711.rar
    55,7 KB · Weergaven: 30
Hmmmm.... ik kan niet met het bestand werken. Alleen maar openen in de viewer. (.xlsm)
Ik heb hier op het werk alleen maar Office2000, dus dat gaat niet werken :cry:
 
2 regel naar beneden

Herkansing. Ik kreeg hem eerst niet onder de 200 kb. Vandaar dat ik 2007 formaat had gebruikt.


Ik heb nu het tabblad printmacro verwijderd om onder de 100 kb te komen.
 

Bijlagen

  • Overzicht RESDUB P09-200711.rar
    46,2 KB · Weergaven: 13
Code: 
Range("A6").Select
    Selection.End(xlDown).Select
    
    Range("A66").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A66:A468").EntireRow.Delete

Wat doe je hier?
- Je selecteert eerst A6 en selecteert alles tot A66 << Wat is hier de functie van?
Dan selecteer je A66 tot A68 (snap ik)
 
2 regel naar beneden

Met deze actie verwijder ik weer de wit regels tussen de twee draaitabellen.
 
2 regel naar beneden

Maar mijn grote probleem is dat deze reeks bij iedere draaitabel anders is. Daarom voeg ik eerst 500 regels toe. Maar ik weet niet automatisch hoeveel ik er kan verwijderen. Ik weet wel dat er altijd maar 2 tussen mogen blijven staan.
 
Maaaaaar, jouw code geeft aan dat je A6 tot A66 selecteerd en dan dan A66 tot A468
Of denk ik nu verkeerd?

Maak een Backup van origineel bestand en vervang de code in Module1 met:

Code: 
Option Explicit

Sub PRINTEN17742()
    Sheets("Voorblad").Range("B25").Select
    ActiveCell.FormulaR1C1 = "17742 B.U. BOTLEK"

    With Sheets("Overzicht ")
        .Range("A6").Select
        Selection.End(xlDown).Offset(2, 0).Select
        Range("A" & ActiveCell.Row & ":A" & ActiveCell.Row + 500).EntireRow.Insert

        With .PivotTables("Draaitabel10").PivotFields("B.U.")
            .ClearAllFilters
            .CurrentPage = "17742 B.U. BOTLEK"
        End With

        Range("A6:A468").EntireRow.Delete      '   Verwijder lege regels

        With .PivotTables("Draaitabel13").PivotFields("B.U.")
            .ClearAllFilters
            .CurrentPage = "17742 B.U. BOTLEK"
        End With
    End With

    Sheets(Array("Voorblad", "Overzicht ")).Select
    Sheets("Overzicht ").Activate

    If Application.Dialogs(xlDialogPrinterSetup).Show Then
       ActiveWindow.SelectedSheets.PrintOut
    End If

    Sheets("PRINT MACRO'S").Select
    Application.Goto Reference:="R4C3"
End Sub

Gaat dit goed?
 
Laatst bewerkt:
2 regel naar beneden

Bij mij loopt hij nu vast op de eerste regel

Code: 
 Sheets("Voorblad").Range("B25").Select

Kan u de excel niet terugsturen. Dan plak ik mijn gegevens wel daarin.
 
Je hebt "Voorblad" gereserveerd, Maak er "Voorblad " (met spatie) van.
En je hoeft echt geen "u" te zeggen. Gewoon informeer blijven ;)

EDIT: Even wachten... Klopt niet wat i,k zeg..... Kom er zo op terug.
 
Laatst bewerkt:
Er blijkt veel meer aan de hand met deze code. Ben nu even aan het testen en proberen.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan