Nummer van werkblad in ander werkblad

Status
Niet open voor verdere reacties.

jmdejong

Gebruiker
Lid geworden
9 dec 2008
Berichten
5
Hallo Experts,

Ik ben bezig met een loop in VBA excel. In die loop haalt hij waardes uit kolom A in werkblad 1 en stopt die in een Array. Vervolgens maakt hij deze array weer leeg in kolom N van werkblad 3 met respectievelijk de rijen. Nu wil ik dat in kolom D van werkblad 3 het nummer komt te staan van het werkblad waar ik kolom A heb ingelezen met respectievelijk de rijen. Ik ga dit straks uitbreiden, zo dat ik ook in werkblad 2 de waarden van kolom A in werkblad 3 ga zetten. Maar ik wil dus zien in werkblad 3 uit welk werkblad de waarden gehaald worden.

Dit is een deel van wat ik tot nu toe heb:
Code:
Dim strRnrs() As String
Dim ws3 As Worksheet
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim strControle As String 'inhoud van de cel om te controleren
Dim strControle2 As String 'inhoud van de cel om te controleren
Dim x, y As Integer 'tellers voor de celverplaatsing
Dim i, k, n As Integer 'teller voor de Rnrs
Dim t As Integer 'teller aantal nieuwe R

i = 0
    x = 1
    Do While True
        i = i + 1
        x = x + 1
        strControle = Cells(x, 1).Value
        strControle2 = Cells(x, 2).Value
        If Cells(x, 2).Value = "" Then
        t = t + 1
        Else
        End If
        If strControle <> "" Then
            If strControle2 = "" Then
                ReDim Preserve strRevalidantnrs(i)
                strRevalidantnrs(i) = strControle
            End If
        Else
        i = i - 1
        t = t - 1
        Exit Do
        End If
    Loop
End If
k = i 'hoogste waarde van de array
'*********  Einde 1 + 2 ****************************

'=================================================
'3. haalt Rnrs uit de array en zet ze in werkblad 3
'=================================================
'herinitialisatie
x = 3
ws3.Activate
If t <> 0 Then
    For i = 1 To k
        strControle = strRnrs(i)
        Cells(x, 14).Value = strControle
        x = x + 1
        Cells(x, 14).Value = strControle
        x = x + 1
    Next i
Else
Me.Hide
MsgBox ("Er zijn geen nieuwe Rnrs ingevoerd.")
ws1.Activate
End If

Ik hoop dat jullie mij kunnen helpen.

Alvast bedankt,
Bi||
 
Dat kan iets eenvoudiger

Code:
with sheets(1).cells(1,1).currentregion
  .autofilter 2,"="""
  .specialcells(xlcelltypevisible).copy sheets(3).Range("N1")
  .autofilter
End with
sheets(3).Range("N1").currentregion.resize(,1).offset(,-10).value=1
 
Dat kan iets eenvoudiger

Code:
with sheets(1).cells(1,1).currentregion
  .autofilter 2,"="""
  .specialcells(xlcelltypevisible).copy sheets(3).Range("N1")
  .autofilter
End with
sheets(3).Range("N1").currentregion.resize(,1).offset(,-10).value=1

Nu ben ik niet zo'n held in VBA (ben 2 weken geleden begonnen). Klopt het dat je met bovenstaande doelt op onderstaande?
Code:
i = 0
    x = 1
    Do While True
        i = i + 1
        x = x + 1
        strControle = Cells(x, 1).Value
        strControle2 = Cells(x, 2).Value
        If Cells(x, 2).Value = "" Then
        t = t + 1
        Else
        End If
        If strControle <> "" Then
            If strControle2 = "" Then
                ReDim Preserve strRnrs(i)
                strRnrs(i) = strControle
            End If
        Else
        i = i - 1
        t = t - 1
        Exit Do
        End If
    Loop
End If

Ik heb geprobeerd hem te vervangen, maar hij geeft foutmelding 13:
Typen komen niet met elkaar overeen.

Ik hoop dat je het niet heel erg vindt als ik voorlopig de huidige manier laat staan, want die snap ik en dat is in programmeren toch wel het belangrijkst.

Maar waar ik meer in geinteresseert ben is, dat ik het werkbladnummer in Kolom D krijg op werkblad 3 bij het respectievelijke nummer uit kolom A in werkblad 1.

Laat me weten of jullie op een lumineus idee komen. Ik probeer en wacht af.

Groeten,
Bi||
 
Ja, mijn suggestie vervangt jouw code volledig.
Je vergat erbij te vertellen in welke regel de foutmelding wordt gegeven.

Probeer deze aangepaste versie eens.
En test even of sheets(1) en sheets(3) wel de beoogde sheets zijn.
En, o ja, kopieer mijn suggestie in plaats van overtypen (een punt is zo over het hoofd gezien.)

Code:
Sub tst()
with sheets(1).cells(1,1).currentregion
  .autofilter 2,""
  .specialcells(xlcelltypevisible).copy sheets(3).Range("N1")
  .autofilter
End with
sheets(3).Range("N1").currentregion.resize(,1).offset(,-10).value=1
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan