Alle cijfers in kolom C van elk tabblad kopieren naar ander tabblad

[janmulder85]

Hallo,

Ik wil graag uit een werkmap alle cijfers die in de kolom C van elk tabblad voorkomt kopieren naar het tabblad 'filterblad'. Daar moeten de cijfers vervolgens komen te staan in E4 en de rij daaronder (dus E5, E6 enz.) Bij de formule die ik gebruik selecteerd hij niet alle getallen uit de tabbladen. Kan iemand de fout ontdekken of moet er misschien iets toegevoegd worden?

Alvast dank voor de reacties! :thumb:

Dit is mijn formule:

Sheets(werkmap).Select
    Range("A65536").Select
    Selection.End(xlUp).Select
    tmp = ActiveCell.Address
    tmp = Right(tmp, Len(tmp) - 1)
    laatsteregel = Val(Mid(tmp, InStr(tmp, "$") + 1))
    
    If Range("A" & laatsteregel) <> "code:" Then
        Range("A65536").Select
        Selection.End(xlUp).Select
        tmp = ActiveCell.Address
        tmp = Right(tmp, Len(tmp) - 1)
        rij = Val(Mid(tmp, InStr(tmp, "$") + 1))
        
        Range("C8:C" & rij).Select
      Else
        Range("C8").Select
    End If
   'werkmap copieren
    Selection.Copy
    Sheets("filterblad").Select
    If z = 1 Then
       Range("E4").Select
       Else
         Range("E" & laatsterij + 1).Select
       End If
       Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

 

[Wigi]

Jan

Post eens je code tussen code tags aub, dan wordt het leesbaar voor iedereen.

Over de code zelf: begin met variabelen te declareren, dat is het eerste dat je moet doen. Wat is trouwens variabele z? Of is dit hier maar een stuk uit jouw code? In jouw code hier zal z nl. nooit 1 worden.

Wigi

 

[huijb]

@janmulder85 fout in vba zegt niets over je probleem. Titel aangepast en code tussen de tags geplaatst. Als je dit leest weet je meer.

 

[janmulder85]

Mijn excuses, ik zie inderdaad dat het tussen tags beter leest. Volgende keer beter dan maar...

@ Wigi: z=1 verwijst naar een tabblad dat is vernoemd naar 1, het klopt dat dit inderdaad een gedeelte uit de code is. Het is een goed werkende code die ik wou uitbreiden, dus heb ik het gedeelte gekopieerd en de cellen veranderd. Vandaar mijn vraag waarom het niet werkt. Dit is de originele code:

Sub filtergegevens()
    
    crediteurfilter
    basislijstfilter
    
    Application.ScreenUpdating = False
    Application.StatusBar = "Inlezen data....."
    Sheets("filterblad").Visible = True
    Sheets("filterblad").Select
    Range("C5").FormulaR1C1 = "_"
    
    Range("C65536").Select
    Selection.End(xlUp).Select
    tmp = ActiveCell.Address
    tmp = Right(tmp, Len(tmp) - 1)
    laatsterij = Val(Mid(tmp, InStr(tmp, "$") + 1))
    
    Range("B4:BA" & laatsterij).Select
    Selection.EntireRow.Delete
    Range("C4").Select
    
    z = 1
    Do While z < 8
    If z = 1 Then werkmap = "Ma"
    If z = 2 Then werkmap = "Di"
    If z = 3 Then werkmap = "Wo"
    If z = 4 Then werkmap = "Do"
    If z = 5 Then werkmap = "Vr"
    If z = 6 Then werkmap = "Za"
    If z = 7 Then werkmap = "Zo"
    

    Sheets(werkmap).Select
    'laatste rij selecteren
    Range("A65536").Select
    Selection.End(xlUp).Select
    tmp = ActiveCell.Address
    tmp = Right(tmp, Len(tmp) - 1)
    laatsteregel = Val(Mid(tmp, InStr(tmp, "$") + 1))
    
    If Range("A" & laatsteregel) <> "code:" Then
      'If Range("A" & laatsteregel) = "code:" Then
      'laatste rij opzoeken
        Range("A65536").Select
        Selection.End(xlUp).Select
        tmp = ActiveCell.Address
        tmp = Right(tmp, Len(tmp) - 1)
        rij = Val(Mid(tmp, InStr(tmp, "$") + 1))
        
        Range("A65:C" & rij).Select
      Else
        Range("A65").Select
    End If
   'werkmap copieren
    Selection.Copy
    Sheets("filterblad").Select
    If z = 1 Then
       Range("C4").Select
       Else
         'laatste rij opzoeken
         Range("C65536").Select
         Selection.End(xlUp).Select
         tmp = ActiveCell.Address
         tmp = Right(tmp, Len(tmp) - 1)
         laatsterij = Val(Mid(tmp, InStr(tmp, "$") + 1))
    
         Range("C" & laatsterij + 1).Select
       End If
       ActiveSheet.Paste

De code hierboven kopieert gegevens vanaf A65 en de rij eronder naar tabblad 'filterblad'
Nu wil ik graag een variant erbij maken die zoals eerder beschreven de cijfers uit de kolom C8 en de rij eronder van m'n werkblad kopieert naar E4 enz. van tabblad 'filterblad'.

De originele code werkt feilloos...