255 karakter limiet in array omzeilen met vba

[robinri]

hallo vba experts...

Ik heb een mooi werkende vba oplossing die ik al jaren gebruik om een beperkte hoeveelheid data uit verschillende tabbladen in een tabel te zetten in een nieuw tabblad.
Dit werkt uitstekend maar toch een vraag hierover omdat mij gevraagd is alle data uit de volgende tabbladen in een tabel te krijgen.

Er is een array van cellen met tekst in de tabbladen die worden weggeschreven naar de dictionary.
Een aantal van deze cellen bevat meer dan 255 tekens.
Bij het in de tabel schrijven gaat het mis op het moment dat die cel moet worden geschreven, er komt een "Fout 13 tijdens uitvoering", "Typen komen niet overeen"

Ik heb even een sterk vereenvoudigd bestandje gemaakt voor hier.
In het voorbeeldbestand is dit eenvoudig te vinden door in cel I13 van blad N het 256e karakter toe te voegen en de macro te draaien op het tabblad Consolidated.

Mijn vraag is: Kan ik dit omzeilen met vba code en alle gegevens, dus ook cellen met 255+ karakters erin, in de tabel krijgen?

 

[VenA]

Welke versie van Excel gebruik je? In XL-2016 werkt het wel.

Zo werkt het ook in XL-2010

Sub VenA()
  ReDim ar(Sheets.Count * 22, 13)
  For Each sh In Sheets
    If Len(sh.Name) = 1 Then
      ar1 = sh.Cells(6, 3).CurrentRegion
      For j = 3 To UBound(ar1)
        ar(t, 0) = sh.Name
        For jj = 2 To UBound(ar1, 2)
          ar(t, jj - 1) = ar1(j, jj)
        Next jj
        t = t + 1
      Next j
    End If
  Next sh
  With Sheets("consolidated").ListObjects(1)
    If .ListRows.Count Then .DataBodyRange.Delete
    .ListRows.Add.Range.Resize(t, 14) = ar
  End With
End Sub

 

[robinri]

VenA, hartelijk dank voor je snelle oplossing. Werkt idd mooi:thumb:

Ik werkte in XL 2010 maar heb ook wel een 2016 versie op mijn laptop, zal daar mijn origineel ook even op testen.

VBA noob als ik ben heb even rustig de tijd nodig om te begrijpen wat je in de code heb staan. Vandaar ook de testverklaring in mijn code.
Iets gebruiken zonder dat ik exact weet "hoe en wat" zit me niet lekker dus ik ga even aan de studie met wat je schrijft.

In mijn origineel krijg ik een foutmelding 1004 (door toepassing of object gedefinieerde fout) in de regel .ListRows.Add.Range.Resize(t, 14) = ar

 

[robinri]

nog steeds foutmelding en ik weet niet wat ik moet aanpassen

Ik heb geen idee wat ik moet aanpassen in de code van VenA om hem werkend te krijgen in mijn bestand. In het oorspronkelijke voorbeeld werkt het prima...
Ik wil het zelf oplossen maar heb toch echt weer wat hulp nodig...
Zou je (VenA) of ieder andere specialist, nog eens naar willen kijken en mij wat uitleg verstrekken zodat ik in de toekomst het zelf kan?

groeten en alvast bedankt, Rob

 

[cow18]

zonder array, omweg via een dictionary
uitleg in de macro
in sommige cellen staat er een tekst van 600 karakters

 

[VenA]

Niet geheel gecontroleerd of het bereik goed is maar wel wel alles binnen een array

Sub VenA()
  ReDim ar(Sheets.Count * 22, 13)
  For Each sh In Sheets
    If sh.Name <> "Consolidated" Then
      ar1 = sh.Cells(8, 3).Resize(15, 13)
      For j = 1 To UBound(ar1)
        ar(t, 0) = sh.Name
        For jj = 2 To UBound(ar1, 2)
          ar(t, jj - 1) = ar1(j, jj)
        Next jj
        t = t + 1
      Next j
    End If
  Next sh
  With Sheets("consolidated").ListObjects(1)
    If .ListRows.Count Then .DataBodyRange.Delete
    .ListRows.Add.Range.Resize(t, 14) = ar
  End With
End Sub

Bij een aangesloten bereik zonder de de 'lege' rijen

ar1 = sh.Cells(8, 3).Resize(sh.Columns(3).SpecialCells(2, 1).Count, 13)

 

[cow18]

klopt inderdaad, die cel van 600 karakters gaat ook netjes mee:thumb:

 

[snb]

Niet getest, maar wellicht:

Sub M_snb()
  With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    For Each it In Sheets
      If Left(it.Name, 1) <> "C" Then
        it.Range("C8:O22").Copy
        .GetFromClipboard
        c00 = c00 & vbCrLf & .GetText
      End If
    Next

    .SetText c00
    .PutInClipboard
  End With
   
 Blad5.Paste Cells(2, 1)
End Sub

 

[cow18]

dat moet ik eerst nog eventjes laten bezinken, black magic ...

 

[robinri]

@Cow18, super bedankt voor je uitleg! :thumb: Je hebt me op deze manier snel verder geholpen.
Met je uitleg in het bestand kon ik de VenA oplossing snel zo aanpassen dat ik alles nu mooi werkend heb.

@VenA, dank je voor de gewijzigde versie. Ik heb deze zo aangepast dat alles netjes werkt zoals ik het bedoelde.

@snb, ik zie alleen dat je het eerste tabblad mooi in de tabel zet maar dat beantwoord niet de oorspronkelijke vraag.

Ik zet de vraag als opgelost