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

vba probleempje

Status
Niet open voor verdere reacties.
G

ginogcsbelgie

Gebruiker
Lid geworden
17 nov 2014
Berichten
63
Beste forumleden,

Ik ben met een projectje bezig waarmee ik een adreslijst wil afgaan om telkens adressen te kopieren naar een pagina waar een brief staat

ik wil met een knop werken die alle adressen 1 voor 1 kopieert naar die brief pagina en afdrukt tot deze een leeg veld tegenkomt in kolom c en dan stopt omdat de adresingave ten einde is.
ik heb onderstaande code geprobeerd maar deze stopt telkens na het eerste adres alhoewel er nu al 3 lijnen adres zijn ingevuld. na het kopieren van de eerste lijn zegt hij al dat al de brieven zijn afgedrukt, daar er nog twee lijnen moeten gekopieerd worden.
kan iemand mij hiermee helpen aub?
Hartelijk dank


Sub Adres1()

If Range("c6").Value = "" Then
MsgBox "Alle brieven zijn afgedrukt", vbOKOnly, "Invalid Entry"
Exit Sub

End If

Range("C6:G6").Select
Selection.Copy
Sheets("BRIEF").Select
Range("G7").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("A1").Select
Sheets("ADRESLIJST").Select
Range("Q3").Select
Application.CutCopyMode = False
Selection.Copy
Range("R3").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("BRIEF").Select
Range("B14:E14").Select


If Range("c7").Value = "" Then
MsgBox "Alle brieven zijn afgedrukt", vbOKOnly, "Invalid Entry"
Exit Sub

End If

Range("C7:G7").Select
Selection.Copy
Sheets("BRIEF").Select
Range("G7").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("A1").Select
Sheets("ADRESLIJST").Select
Range("Q3").Select
Application.CutCopyMode = False
Selection.Copy
Range("R3").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("BRIEF").Select
Range("B14:E14").Select

End Sub
If Range("c7").Value = "" Then
MsgBox "Alle brieven zijn afgedrukt", vbOKOnly, "Invalid Entry"
Exit Sub

End If

Range("C8:G8").Select
Selection.Copy
Sheets("BRIEF").Select
Range("G7").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("A1").Select
Sheets("ADRESLIJST").Select
Range("Q3").Select
Application.CutCopyMode = False
Selection.Copy
Range("R3").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("BRIEF").Select
Range("B14:E14").Select

End Sub
 
Member sinds 14 nov 2014 en geen voorbeeldbestand.??

Zal zoiets worden.
Code: 
Sub Kopy()
i = Range("C" & Rows.Count).End(xlUp).Row
For j = 6 To i
  Sheets("BRIEF").Range("G7").Resize(5) = WorksheetFunction.Transpose(Range("C" & j).Resize(, 5))
  Sheets("Brief").PrintPreview
Next j
End Sub

Q3 kopy naar R3 ???
 
nog 1 klein probleempje , als er een regel bij is waar niks staat ingevuld in kolom c zou hij deze lijn moeten overslagen en dat doet hij niet, heb je hier nog een antwoord op?
alvast bedankt voor de hulp
 
Sub Kopy()
i = Range("C" & Rows.Count).End(xlUp).Row
For j = 6 To i
Sheets("BRIEF").Range("G7").Resize(5) = WorksheetFunction.Transpose(Range("C" & j).Resize(, 5))
Sheets("Brief").PrintPreview
Next j
End Sub
 
Goeiemorgen AD1957, ik heb op alle manieren geprobeerd en krijg telkens een compileerfout dat ik dit laatste stukje tussen de vorige code plak, alleen op deze manier werkt de macro maar hij pakt rij c nog steeds mee bij het afdrukken ook al is die cel leeg dus ik doe iets verkeerd maar geraak er niet uit?
Kan je me hier nog even mee helpen aub, alvast hartelijk dank
Heb ook een voorbeeld mee gepost van het bestand
Beleefde groeten

Code: 
Sub versturen()
'
' Versturen Macro


i = Range("c" & Rows.Count).End(xlUp).Row
For j = 6 To i
  Sheets("BRIEF").Range("G7").Resize(5) = WorksheetFunction.Transpose(Range("c" & j).Resize(, 5))
  Sheets("Brief").PrintPreview
Next j

If Range("C" & j) <> "" Then
End If
End Sub
 

Bijlagen

  • MailingTest.xlsm
    26,8 KB · Weergaven: 17
Dat is natuurlijk niet wat AD1957 bedoelde. Nu heb je daar iets staan wat neerkomt op "als.... dan" waarbij er niets volgt op "dan". Daar zal dus niet veel mee gebeuren.
Doe het dus zo:
Code: 
i = Range("c" & Rows.Count).End(xlUp).Row
For j = 6 To i
    If Range("C" & j) <> "" Then
        Sheets("BRIEF").Range("G7").Resize(5) = WorksheetFunction.Transpose(Range("c" & j).Resize(, 5))
        Sheets("Brief").PrintPreview
    End If
Next j
 
@ginogcbelgie,

Zelf ben ik begonnen met een boek "VBA voor beginners", misschien iets voor jou?

Misschien dat je deze code kunt volgen.
Code: 
Sub versturen()

i = Range("C" & Rows.Count).End(xlUp).Row
For j = 6 To i
  If Range("C" & j) <> "" Then
    With Sheets("BRIEF")
      .Range("G7") = Range("D" & j)
      .Range("G8") = Range("E" & j)
      .Range("G9") = Range("F" & j)
      .Range("G10") = Range("G" & j) & " " & Range("H" & j)
      .PrintPreview
    End With
 End If
Next j
 
End Sub
 
Laatst bewerkt:
Hartelijk dank iedereen voor de hulp, het werkt perfect en kan verder bouwen op dit stukje
En het boek ga ik me zeker aanschaffen
Beleefde groeten,
 
Je hebt een paar denkfouten in het bestand staan. In Excel kan je de adressenlijst beter als een tabel opmaken. Alle toestanden als kleurtje, knoppen, onzichtbaar gemaakte rijen, etc zijn overbodig. Brieven maak je niet in Excel (rekenblad) maar in Word(tekstverwerker). Binnen het hele officepakket bestaan er veel mogelijkheden om het geheel aan elkaar te knopen. Wil je het toch allemaal binnen Excel houden, dan zou ik deze code gebruiken:
Code: 
Sub VenA()
  ar = Sheets("ADRESLIJST").Cells(6, 2).CurrentRegion
  With Sheets("BRIEF")
    For j = 1 To UBound(ar)
      If ar(j, 2) <> "" Then
        .Cells(8, 7).Resize(4) = Application.Transpose(Array(ar(j, 3), ar(j, 4), ar(j, 5), ar(j, 6)))
        .PrintPreview
      End If
    Next j
  End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan