sheetvuller vanuit tabel

[Symphysodon]

Beste forummers,

Ik heb een code voor het vullen van bepaalde cellen in bepaalde sheets vanuit een tabel. Het loopen door de sheets gaat goed, alleen worden de cellen niet gevuld met getallen.

Sub dataverwerking()
Dim ws As Variant
Application.ScreenUpdating = False
iR = 8

For Each ws In Worksheets
  s = Left(ws.Name, 1)
  If s = "V" Then
    iK = 1
    uR = 30
    If ws.Name = Sheets("Const").Cells(iR, iK) Then
        For i = 1 To 12
            Cells(uR, 31).Value = Sheets("Const").Cells(iR, iK + 2).Value
            uR = uR + 34
            iK = iK + 1
        Next
    End If
    iR = iR + 1
  End If
Next

Application.ScreenUpdating = True
End Sub

Wat gaat er mis?

Mvg
Marco

 

[Symphysodon]

Voorbeeldbestand:

Bekijk bijlage tabelvuller.xlsm

 

[lam201]

Waar heb je deze code opgeslagen?
in een aparte module? of in een werkblad?

Cells verwijst altijd naar het werkblad waarin de code is opgeslagen.
je kunt dit wijzigen door aan te wijzen in welk werkblad de gegevens moeten worden opgeslagen.
met bijvoorbeeld:

activesheet.Cells(uR, 31).Value = Sheets("Const").Cells(iR, iK + 2).Value

of

Sheets("naam").Cells(uR, 31).Value = Sheets("Const").Cells(iR, iK + 2).Value

Lambert

 

[Symphysodon]

De code is opgeslagen in een module.
Ik heb de code aangepast, maar krijg een foutmelding.

Sub dataverwerking()
Dim ws As Variant
Application.ScreenUpdating = False
iR = 8

For Each ws In Worksheets
  With Sheets(ws)
  s = Left(ws.Name, 1)
  If s = "V" Then
    iK = 1
    uR = 30
    If ws.Name = Sheets("Const").Cells(iR, iK) Then
        For i = 1 To 12
            .Cells(uR, 31).Value = Sheets("Const").Cells(iR, iK + 2).Value
            uR = uR + 34
            iK = iK + 1
        Next
    End If
    iR = iR + 1
  End If
  End With
Next

Application.ScreenUpdating = True
End Sub

Bekijk bijlage tabelvuller.xlsm

 

[lam201]

deze even aanpassen:

With Sheets(ws[COLOR="#FF0000"].name[/COLOR])

 

[Symphysodon]

Tuurlijk, maar het maakt helaas niet uit, er komen nog steeds geen getallen in de sheets beginnend met een V te staan.

 

[lam201]

Dat is omdat je sheets niet in dezelfde volgorde staan als in de tabel.
volgorde sheets: V12, V11, V10
volgorde tablel: V10, V11, V12

alleen in sheet V11 verschijnen de getallen

 

[Symphysodon]

Dan moet ik de code dus anders opbouwen want eigenlijk moet elke aanduiding in de tabel gebruikt worden om de desbetreffende sheets mee te vullen.

 

[Symphysodon]

Lambert,

Super bedankt. Ik heb het opgelost door de tabel te sorteren.

Marco

 

[VenA]

Waarom werk je niet vanuit de tabel? Als je de bewerkingen via een array doet dan werkt het ook nog eens een stuk sneller.

Sub VenA()
  ar = Sheets("Const").ListObjects(1).DataBodyRange
    For j = 1 To UBound(ar)
      If Left(ar(j, 1), 1) = "V" Then
        With Sheets(ar(j, 1)).Cells(30, 31).Resize((UBound(ar, 2) - 2) * 34 - 4)
          ar1 = .Value
          For jj = 3 To UBound(ar, 2)
            ar1((jj - 3) * 34 + 1, 1) = ar(j, jj)
          Next jj
          .Value = ar1
        End With
      End If
    Next j
End Sub

 

[Symphysodon]

Knap, inderdaad een stuk sneller.

Bedankt.

 

[snb]

Of zo: (iets minder interaktie met de werkbladen)

Sub M_snb()
  ar = Sheets("Const").ListObjects(1).DataBodyRange
  ReDim sn(UBound(ar, 2) * 34, 0)
    
  For j = 1 To UBound(ar)
      If Left(ar(j, 1), 1) = "V" Then
          For jj = 0 To UBound(ar, 2) - 3
            sn(34 * jj, 0) = ar(j, jj + 3)
          Next
       
         Sheets(ar(j, 1)).Cells(30, 31).Resize(UBound(sn)) = sn
      End If
    Next
End Sub

 

[Symphysodon]

ik ben nog aan het studeren op die van VenA, want helemaal snappen doe ik het nog niet.

Bedankt

 

[snb]

Misschien vind je deze gemakkelijker:

Sub M_snb()
  sn = Sheets("Const").ListObjects(1).DataBodyRange

  For j = 1 To UBound(sn)
      If Left(sn(j, 1), 1) = "V" Then
         sp = Split(Mid(Join(Application.Index(sn, j), Space(34)), 72))
         Sheets(sn(j, 1)).Cells(30, 31).Resize(UBound(sp) + 1) = Application.Transpose(sp)
      End If
    Next
End Sub