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

waardes kopieren ipv formules

Status
Niet open voor verdere reacties.

moensk

Gebruiker
Lid geworden
23 jun 2013
Berichten
778
ik gebruik bijgaand script wat goed werkt
in mijn tabblad "data" is er een kolom waar formule instaat.
nu wil ik de waarde kopiëren en plakken ipv de formule naar de Doelsheets

Code:
Sub Verdelen()
Dim x As Integer
    Dim DoelSheet As String
    With Sheets("Data")
        For x = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
            If Not .Rows(x).Hidden Then
                DoelSheet = .Range("AX" & x).Value
                If DoelSheet <> "" Then
                    .Range("A" & x & ":Z" & x).Copy Sheets(DoelSheet).Range("A" & Sheets(DoelSheet).Range("A" & Sheets(DoelSheet).Rows.Count).End(xlUp).Row + 1)
                    Sheets(DoelSheet).Cells(1).CurrentRegion.RemoveDuplicates 3
                End If
            End If
        Next x
    End With
End Sub
 
Code:
Sub Verdelen()
probeer dit eens

Dim x As Integer
    Dim DoelSheet As String
    With Sheets("Data")
        For x = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
            If Not .Rows(x).Hidden Then
                DoelSheet = .Range("AX" & x).Value
               [COLOR="#FF0000"]waarheen=Sheets(DoelSheet).Range("A" & Sheets(DoelSheet).Range("A" & Sheets(DoelSheet).Rows.Count).End(xlUp).Row + 1).address[/COLOR]
                If DoelSheet <> "" Then
                    .Range("A" & x & ":Z" & x).Copy [COLOR="#FF0000"]waarheen[/COLOR]
                    [COLOR="#FF0000"]waarheen = waarheen.value[/COLOR]
                    Sheets(DoelSheet).Cells(1).CurrentRegion.RemoveDuplicates 3
                End If
            End If
        Next x
    End With
End Sub
 
ik krijg fout 9 melding "subscript valt buiten het bereik"
 
Code:
If DoelSheet <> "" Then
                    .Range("A" & x & ":Z" & x).Copy 
                    Sheets(DoelSheet).Range("A" & Rows.Count).End(xlUp).offset(1).pastespecial xlpastevalues
                end if
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan