kan deze macro korter??

[johnsharda]

bestand doet het wel maar de macro word zo wel erg lang, iemand een oplossing hiervoor?

Sub facturen()
Sheets("huurders").Select
Range("A4").Select
Selection.Copy

Sheets("factuur").Select
Range("B10").Select
ActiveSheet.Paste


Range("a1:e71").Copy
Sheets("print").Select

Range("a65535").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False



'als er lege rij is


Sheets("huurders").Select
If Range("a5") = "" Then

Sheets("print").Select
ActiveWindow.SelectedSheets.PrintPreview

End If




Range("A5").Select
Selection.Copy

Sheets("factuur").Select
Range("B10").Select
ActiveSheet.Paste

Range("a1:e71").Copy
Sheets("print").Select

Range("a65535").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'-------------------------------------------------------


Sheets("huurders").Select
If Range("a6") = "" Then

Sheets("print").Select
ActiveWindow.SelectedSheets.PrintPreview

End If




Range("A6").Select
Selection.Copy

Sheets("factuur").Select
Range("B10").Select
ActiveSheet.Paste

Range("a1:e71").Copy
Sheets("print").Select

Range("a65535").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'-------------------------------------------



Sheets("huurders").Select
If Range("a7") = "" Then

Sheets("print").Select
ActiveWindow.SelectedSheets.PrintPreview

End If




Range("A7").Select
Selection.Copy

Sheets("factuur").Select
Range("B10").Select
ActiveSheet.Paste

Range("a1:e71").Copy
Sheets("print").Select

Range("a65535").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'-------------------------------------------




Sheets("huurders").Select
If Range("a8") = "" Then

Sheets("print").Select
ActiveWindow.SelectedSheets.PrintPreview

End If




Range("A8").Select
Selection.Copy

Sheets("factuur").Select
Range("B10").Select
ActiveSheet.Paste

Range("a1:e71").Copy
Sheets("print").Select

Range("a65535").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'-------------------------------------------



Sheets("huurders").Select
If Range("a9") = "" Then

Sheets("print").Select
ActiveWindow.SelectedSheets.PrintPreview

End If




Range("A9").Select
Selection.Copy

Sheets("factuur").Select
Range("B10").Select
ActiveSheet.Paste

Range("a1:e71").Copy
Sheets("print").Select

Range("a65535").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'-------------------------------------------

 

[edmoor]

Misschien dat je eerst eens al die overbodige lege regels kan verwijderen en zorgen dat de inspringpunten correct gebruikt zijn. Dat maakt het geheel een stuk leesbaarder om eens te kijken naar het inkorten er van.

 

[johnsharda]

welke regels dan?

 

[edmoor]

Meer dan 1 lege regel is er nooit nodig.
En dit bijvoorbeeld:

  If Range("a8") = "" Then
  
  Sheets("print").Select
  ActiveWindow.SelectedSheets.PrintPreview
        
   End If

Hoort zo te zijn:

If Range("a8") = "" Then
    Sheets("print").Select
    ActiveWindow.SelectedSheets.PrintPreview    
End If

Voor het getoonde kleine stukje maakt het natuurlijk niks uit maar als je de hele module moet lezen is het erg slecht te zien wat nou wel en niet bij elkaar hoort qua Sub...End Sub en If...End If bijvoorbeeld.

Schrijf tevens Range aanduidingen met een hoofdletter.
Het getoonde stukje hier boven zou al een stuk korter kunnen door deze zo te schrijven:

If Range("A8") = "" Then Sheets("print").PrintPreview

 

[johnsharda]

oke duidelijk, ik dacht dat je de werkbladen van excel bedoelde

 

[edmoor]

Jij had het over de macro.
Ik ook

 

[roeljongman]

Dat kan inderdaad een heel stuk korter,

voor het doorlopen van lijstjes kun je naar loops gebruiken. de code steeds herhalen is niet werkbaar als er 1 huurder bij komt of af gaat moet je de macro aanpassen. dat is geen automatiseren

Sub facturen()
lLastRow = Sheets("huurders").Range("A4").End(xlDown).Row 'vind de laatste 

For i = 4 To lLastRow
    Sheets("huurders").Range("A" & i).Copy Range("B10")
    Range("A1:E68").Copy
        With Sheets("print").Range("a65535").End(xlUp).Offset(1, 0)
            .PasteSpecial Paste:=xlPasteAllUsingSourceTheme
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        End With
    Sheets("print").HPageBreaks.Add Before:=Sheets("print").Range("a65535").End(xlUp).Offset(1, 0)
Next i
Sheets("print").PrintPreview
End Sub

jou drie loze regeltjes met 1 waarden heb ik vervangen door een pagebreak

 

[johnsharda]

Bedankt roel, deze werkt prima.
ik begrijp alleen niet wat je bedoeld met de loze regeltjes en de pagebreak?

 

[VenA]

Als de lay-out van het blad 'factuur' al goed is dan lijkt mij het kopiëren van de gegevens naar een ander blad niet zinvol.

Sub VenA()
  ar = Sheets("Huurders").Cells(3, 1).CurrentRegion.Columns(1)
  For j = 3 To UBound(ar)
    Sheets("factuur").Range("B10") = ar(j, 1)
    Sheets("factuur").PrintPreview
  Next j
End Sub

 

[johnsharda]

de gegevens worden gekopieerd naar een ander blad en onder elkaar gezet zodat ik ik de facturen in 1 keer kan printen en niet per stuk.
tevens worden deze dan in 1 bestand opgeslagen.

 

[roeljongman]

John, ik heb in de code pagebreaks toegevoegd na elke factuur (NL: Pagina einde invoegen ) dit zorgt dat de volgende factuur netjes op een nieuwe pagina begint.

Jij had in jou voorbeeld op blad print op rij 69 tm 71 in elke cel "1" staan. Ik heb de aanname gedaan om te zorgen dat dit was dat de factuur een hele pagina beslaat en er niet meerdere facturen op 1 geprinte pagina komen.
of dienen die 1 waarden een ander doel en moeten die wel afgedrukt worden?

 

[johnsharda]

dat klopt ja, die 1 stond er voor formaat pagina.
Maar nogmaals bedankt macro werkt prima.

 

[johnsharda]

Bekijk bijlage test voor huuders facturen2.xlsm

toch een probleem:
Als ik op het blad "factuur" cel b9 wijzig veranderd alles mee(adres,postc,woonpl enz), maar als ik de macro gebruik veranderd alleen cel b9
overigens staat in de macro cel b10?

wat doet ik nu fout?

 

[roeljongman]

Je hebt een regel verwijderd, in je vorige voorbeeld stond de naam van de huurder in B10 nu in B9
dus je moet in de code B10 wijzigen in B9

 

[johnsharda]

klopt die heb ik verwijderd omdat op de een of andere manier de macro de waarde in b9 zet.
als je nu de macro start zet die de waarde in b9 terwijl in de macro op b10 staat

 

[snb]

Kijk ook eerst eens hier: http://www.barnesandnoble.com/w/excel-vba-programming-for-dummies-john-walkenbach/1101874584

 

[johnsharda]

kan ik die van jou lenen?