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

macro aanpassen

Status
Niet open voor verdere reacties.
R

Ron321

Gebruiker
Lid geworden
15 jul 2005
Berichten
555
Ik heb de volgende macro opgenomen:
Code: 
Sub Macro1()
'
' Macro1 Macro
' blad invoegen
'

'
    Sheets("klant14").Select
    Sheets("klant14").Copy After:=Sheets(15)
    Sheets("klant14 (2)").Select
    Sheets("klant14 (2)").Name = "klant15"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=voorblad!R16C"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "=voorblad!R16C[1]"
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "=voorblad!R16C[2]"
    Range("B5").Select
    ActiveCell.FormulaR1C1 = "=voorblad!R16C[3]"
    Range("B6").Select
    ActiveCell.FormulaR1C1 = "=voorblad!R16C[4]"
    Range("B7").Select
    ActiveCell.FormulaR1C1 = "=voorblad!R16C[5]"
    Range("B8").Select
    Selection.ClearContents
    Range("B9").Select
    Selection.ClearContents
    Range("B10").Select
    Selection.ClearContents
    Range("B12").Select
    Selection.ClearContents
    Range("B13").Select
    Selection.ClearContents
    Range("B14").Select
    Selection.ClearContents
    Sheets("voorblad").Select
    Range("A16").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "klant15!A1", TextToDisplay:="15"
End Sub
Hoe kan ik deze variabel maken?
Met andere woorden dat hij steeds een hoger nummer kiest en dus naar het laatste blad gaat?
 
Code: 
Sub Macro1()

    Dim lAantalBladen As Long
    Dim wsLaatsteBlad As Worksheet
    
    lAantalBladen = ThisWorkbook.Worksheets.Count
    
    Set wsLaatsteBlad = ThisWorkbook.Sheets(lAantalBladen)
    
    wsLaatsteBlad.Copy after:=wsLaatsteBlad
    
    With ThisWorkbook.Sheets(lAantalBladen + 1)
    
        .Name = "klant" & CDbl(Replace(wsLaatsteBlad.Name, "klant", "")) + 1
        .Range("B2:B7").FormulaR1C1 = "=voorblad!R16C"
        .Range("B8:B10", "B12:B14").ClearContents
    
    End With
    
End Sub

Ik heb nu al veel gedaan, nu mag jij de hyperlink nog leggen, via de dingen die hierboven al staan.

Wigi
 
Bedankt, als ik morgen tijd heb ga ik even stoeien.

Moet nog even uitdokteren hoe ik deze ook oplopend maak:
Code: 
Range("B2:B7").FormulaR1C1 = "=voorblad!R16C"
 
Dat past zich volgens mij automatisch aan, al heb ik het niet getest.
 
Het past zich niet automatisch aan en ik kom er ook niet uit hoe wel.

En met de hyperlink lukt het ook niet.:(

Dit heb ik geprobeerd:
Code: 
Sheets("voorblad").Select
    Do Until ActiveSheet.Cells(VrijeRij, 1).Value = ""
        ActiveSheet.Cells(VrijeRij, 1).Select
        VrijeRij = VrijeRij + 1
    Loop
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "klant15!A1", TextToDisplay:="15"
 
Doe eens een voorbeeldbestandje, met zowel mijn als jouw code erin.
 
Wigi schreef:
Code: 
Sub Macro1()
Dim lAantalBladen As Long
Dim wsLaatsteBlad As Worksheet   
lAantalBladen = ThisWorkbook.Worksheets.Count
Set wsLaatsteBlad = ThisWorkbook.Sheets(lAantalBladen)
wsLaatsteBlad.Copy after:=wsLaatsteBlad
With ThisWorkbook.Sheets(lAantalBladen + 1)    
[b].Name = "klant" & CDbl(Replace(wsLaatsteBlad.Name, "klant", "")) + 1[/b]
.Range("B2:B7").FormulaR1C1 = "=voorblad!R16C"
.Range("B8:B10", "B12:B14").ClearContents 
End With   
End Sub
Die macro loopt bij mij (en vermoedelijk ook bij anderen??) vast op de vetgemaakte regel.

Wigi schreef:
Ik heb nu al veel gedaan, nu mag jij de hyperlink nog leggen, via de dingen die hierboven al staan.
Klik om te vergroten...
Ik zie hierboven geen dingen staan waaruit op te maken valt hoe de vragensteller
die hyperlink zou moeten leggen (of kijk ik niet goed?).

Wigi schreef:
Dat past zich volgens mij automatisch aan, al heb ik het niet getest
Klik om te vergroten...
Uit de macro van de vragensteller maak ik op dat hij de te kopiëren range wil transponeren, dus je formule in de regel:
Code: 
.Range("B2:B7").FormulaR1C1 = "=voorblad!R16C"
zal zich niet - of niet goed - aanpassen.


Ron321,
Ik weet niet of ik je bedoelingen helemaal begrepen heb, maar probeer onderstaande macro eens
en als die niet doet wat hij moet doen, laat dan eens weten wat er nog veranderd moet worden.
Voor een goede werking van de macro moet er in de werkmap een blad aanwezig zijn met de naam Voorblad,
en ook minimaal 1 blad met de naam klant gevolgd door een klantnummer, dus bv. klant14, of klant1 .
Code: 
Sub macro1()
Dim aantalbladen As Integer, klantnr As Integer
Dim wsLaatsteBlad As Worksheet
aantalbladen = ThisWorkbook.Worksheets.Count
Set wsLaatsteBlad = ThisWorkbook.Sheets(aantalbladen)
klantnr = Mid(wsLaatsteBlad.Name, 6, Len(wsLaatsteBlad.Name) - 5) + 1
wsLaatsteBlad.Copy after:=wsLaatsteBlad
Application.ScreenUpdating = False
With ThisWorkbook.Sheets(aantalbladen + 1)
.Name = "klant" & klantnr
.Range("B2:B7").FormulaArray = "=transpose(Voorblad!R[14]C:R[14]C[5])"
.Range("B8:B14").ClearContents
End With
With Worksheets("Voorblad")
.Activate
.Hyperlinks.Add anchor:=.Range("A65536").End(xlUp).Offset(1, 0), _
Address:=ThisWorkbook.Name & "#klant" & klantnr & "!A1", TextToDisplay:=Str(klantnr)
End With
Application.ScreenUpdating = True
End Sub
 
Laatst bewerkt:
De code van Wigi doet het goed alleen die ene regel past zich niet aan en ik weet niet wat ik met de hyperlink aan moet.

Ik zal jouw code eens proberen, bedankt voor de moeite alvast.
En Wigi uiteraard ook.
 
@Zapatr, jouw code werkt goed, de hyperlink is perfect alleen is nog steeds die ene regel niet variabel.
Code: 
.Range("B2:B7").FormulaArray = "=transpose(Voorblad!R[14]C:R[14]C[5])"
Hij moet steeds een regel naar beneden opschuiven.
 
Laatst bewerkt:
Dat komt wel in orde, maar eerst even deze vraag:
Zijn het op het voorblad steeds gegevens uit de laatste regel met gegevens die je wil kopiëren?
 
Ja inderdaad.
Op het voorblad staat in kolom A het klantnummer als hyperlink.
Daar achter in de volgende kolommen (B t/m G) de gegevens die ik wil kopieeren.
 
Moet dat kopiëren per se met formules die in de cel geplaatst worden en in de cel blijven staan of mag het ook anders?
 
Met formules is wel makkelijk want als ik later bijv. een adres wijzig op het voorblad moet dat ook wijzigen op het besbetreffende klantblad.
 
Met onderstaande code zou het moeten lukken.
Kan zijn dat de plaats van de hyperlink nog gewijzigd moet worden, want als het steeds de laatste rij is die moet worden gekopieerd, dan wordt op het voorblad de laatst ingevulde cel in kolom A overschreven. Maar dat nog aanpassen is kinderspel.
Probeer de macro en laat aub even weten of er nog iets niet goed gaat.
Code: 
Sub macro3()
Dim aantalbladen As Integer, klantnr As Integer
Dim wsLaatsteBlad As Worksheet, lr As Integer
aantalbladen = ThisWorkbook.Worksheets.Count
Set wsLaatsteBlad = ThisWorkbook.Sheets(aantalbladen)
klantnr = Mid(wsLaatsteBlad.Name, 6, Len(wsLaatsteBlad.Name) - 5) + 1
wsLaatsteBlad.Copy after:=wsLaatsteBlad
lr = Worksheets("Voorblad").Range("B65536").End(xlUp).Row
Application.ScreenUpdating = False
With ThisWorkbook.Sheets(aantalbladen + 1)
.Cells(1, 8) = L
.Name = "klant" & klantnr
.Range("B2:B7").FormulaArray = "=transpose(Voorblad!B" & lr & ":G" & lr & ")"
.Range("B8:B14").ClearContents
End With
With Worksheets("Voorblad")
.Activate
.Hyperlinks.Add anchor:=.Range("A" & lr), Address:=ThisWorkbook.Name & _
"#klant" & klantnr & "!A1", TextToDisplay:=Str(klantnr)
End With
Application.ScreenUpdating = True
End Sub
 
Ik heb de hyperlink werkend gekregen mbv je voorgaande code want daar werkte het al.;)
Alleen pakt hij nog steeds de gegevens van de voorgaande regel.
Code: 
Sub Macro1()

' blad invoegen

Dim aantalbladen As Integer, klantnr As Integer
Dim wsLaatsteBlad As Worksheet, lr As Integer
aantalbladen = ThisWorkbook.Worksheets.Count
Set wsLaatsteBlad = ThisWorkbook.Sheets(aantalbladen)
klantnr = Mid(wsLaatsteBlad.Name, 6, Len(wsLaatsteBlad.Name) - 5) + 1
wsLaatsteBlad.Copy after:=wsLaatsteBlad
lr = Worksheets("Voorblad").Range("B65536").End(xlUp).Row
Application.ScreenUpdating = False
With ThisWorkbook.Sheets(aantalbladen + 1)
.Cells(1, 8) = L
.Name = "klant" & klantnr
.Range("B2:B7").FormulaArray = "=transpose(Voorblad!B" & lr & ":G" & lr & ")"
.Range("B8:B14").ClearContents
End With
With Worksheets("Voorblad")
.Activate
.Hyperlinks.Add anchor:=.Range("A65536").End(xlUp).Offset(1, 0), _
Address:=ThisWorkbook.Name & "#klant" & klantnr & "!A1", TextToDisplay:=Str(klantnr)
End With
Application.ScreenUpdating = True
End Sub
 
Ron321 zei:
Ik heb de hyperlink werkend gekregen mbv je voorgaande code want daar werkte het al.;)
Klik om te vergroten...
Dat ik de code voor de hyperlink correct gemaakt had, daarvan was ik overtuigd.
Alleen vroeg ik mij af of de cel waarin de hyperlink wordt geplaatst de correcte cel is.
Ron321 zei:
Alleen pakt hij nog steeds de gegevens van de voorgaande regel.
Klik om te vergroten...
De macro kijkt wat de laatst ingevulde cel in kolom B is en kopieert de gegevens uit die rij !
Als dat niet juist is, wat moet er dan gekopieerd worden? Je hebt toch de volledige macro gekopieerd?
Misschien moet er naar de laatst ingevulde rij in kolom A gekeken worden?
Zo ja, laat het even weten, want ook dat is eenvoudig aan te passen.
 
Ron,
de macro die je als quote in je laatste bericht plaatste, was niet de laatste door mij geplaatste macro.
Kopieer mijn laatste macro dus VOLLEDIG en wijzig hem pas DAARNA indien nodig.
 
In je laatste code werkte de hyperlink plaatsing niet, die heb ik dus gecopieerd uit de eerste code.
In beide codes werkt de gegevensovername niet, tenminste niet als er nog niets is ingevuld.
Hij moet verwijzen naar dezelfde regel als waar de hyperlink staat.
 
Ron321 zei:
In beide codes werkt de gegevensovername niet, tenminste niet als er nog niets is ingevuld. Hij moet verwijzen naar dezelfde regel als waar de hyperlink staat.
Klik om te vergroten...
Ik heb de code uitvoerig getest en bij mij werkt die prima.
En als bij jou die hyperlink de ene keer wel in de juiste cel geplaatst wordt en de andere keer niet, dan ziet jouw werkblad er anders uit dan ik denk dat het er uitziet.
Je moet goed begrijpen dat de hyperlink pas wordt geplaatst op het einde van de code, NADAT er gekopieerd is. Vandaar ook mijn opmerking over die hyperlink in mijn vorig bericht dat de laatste cel met gegevens in kolom A door die hyperlink overschreven KAN worden.
Op deze manier doorgaan lijkt mij een tijdrovend en nodeloos heen-en-weer geschrijf te worden.
Als ik je bestand kon zien (of een gedeelte ervan), zou je probleem snel opgelost zijn.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan