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

Rijen met tekst uit 2 tabbladen verzamelen op 1 tabblad

Status
Niet open voor verdere reacties.

IvoBookish

Gebruiker
Lid geworden
12 feb 2010
Berichten
111
Beste allen,

Ik heb een onderzoekje met vragen en buiten de multiple-choice vragen sluit ik af met 3 open vragen.
Er zijn 2 doelgroepen met ieder een eigen tabblad.

Nu zou ik een opsomming willen maken op een nieuw tabblad van alle open vragen van beide tabbladen (liefst met een blanco regel er tussen).

Ik kan even niet bedenken hoe ik dit het beste kan gaan doen, kunnen jullie me op weg helpen?

Alvast bedankt..
Bekijk bijlage sandbag.xls
 
Zoiets? Niet echt een helder voorbeeldje en geen verwachte uitkomst te vinden.

Code:
Private Sub Worksheet_Activate()
UsedRange.Clear
For Each sh In Sheets
    sh.Cells(1).CurrentRegion.Copy Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next sh
End Sub
 
Hoi VenA,
Dank voor je input!!

Mijn voorbeeld wat uitgebreid, hoop dat het nu wat duidelijker is?
Ik zou dit bestand willen kunnen delen met anderen en ook bv met mensen die Apple gebruiken, nu dacht ik dat marco's dan liever niet gebruikt moeten worden, maar das wellicht een fabel?
Zou t zonder macro's kunnen, ben er al even mee bezig maar mij lukt het niet.

Bekijk bijlage sandbag2.xls
 
Het resultaat is wel te reproduceren bv

Code:
Sub VenA()
Dim j As Long, jj As Long, t As Long, ar, ar1
With Sheets("rapportage")
    .Cells(1).CurrentRegion.ClearContents
    For Each sh In Sheets(Array("Blad1", "Blad2"))
        ar = sh.Cells(1).CurrentRegion.Resize(, 3).Offset(, 10)
        ReDim ar1((UBound(ar) - 1) * UBound(ar, 2))
        ar1(t) = sh.Name & ":"
        For j = 1 To UBound(ar, 2)
            For jj = 2 To UBound(ar)
                t = t + 1
                ar1(t) = ar(jj, j)
            Next jj
        Next j
        .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(ar1) + 1) = Application.Transpose(ar1)
        t = 0
    Next sh
    .Cells(1).Delete Shift:=xlUp
End With
End Sub

Wat je er verder mee wilt is mij niet duidelijk. Volgens mij kan je op een MAC ook wel VBA gebruiken en zal deze code denk ik werken. Een groter probleem is dat lang niet iedereen het gebruik van macro's aan heeft staan. Het nut van het opslaan van gelijksoortige gegevens op verschillende tabjes heb ik nog nooit begrepen. Maar zal aan mij liggen;)

Maak er één tabel van en voeg een kolom toe met de doelgroep. Geen VBA nodig en zeer eenvoudig op alle systemen zonder VBA te gebruiken.:d
 
Het gaat om een rapportage, een printout van de openvragen. Vandaar de info in 1 tabblad. Het bestand word per "sessie" opnieuw gevuld met info.
Dus voor ik de VB versie ga gebruiken, 1 tabel maken is prima, alleen moet ik dat dan handmatig knippen plakken uit 3 kolommen en dat is net wat ik niet iedere "sessie" zou willen doen. Eigenlijk is "maak er één tabel van" zo goed als wat ik zou willen bereiken ;-)
 
Code:
Sub M_snb()
    Set kb = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    For Each sh In Sheets
       If Left(sh.Name, 1) = "b" Then
         c00 = c00 & sh.Name & vbCrLf
         For j = 11 To 13
           sh.Columns(j).SpecialCells(2).Offset(1).Copy
           kb.GetFromClipboard
           c00 = c00 & kb.GetText
         Next
       End If
    Next
        
    CreateObject("scripting.filesystemobject").createtextfile("G:\OF\openvragen.txt").write c00
End Sub
 
Hi snb,

Dank voor je input, ik kan de code bijna volgen. (zegt meer over mijn kennis dan over jou code denk ik ;-)
Begrijp ik er dan ook goed uit dat er een txt file op een specifieke locatie word geplaatst, want ik weet niet zo goed of dat wenselijk is.
De resultaten van de vragen worden per sessie naar iemand gestuurd, die moet ze dan kunnen uitprinten bv. Ik ben dus afhankelijk van diegene's instellingen omtrent macro's.
Maar uit beide jullie reacties begrijp ik wel dat het zonder macro's waarschijnlijk niet kan.

Wellicht zal ik het anders moeten gaan doen en is die niet oplosbaar voor me..
 
Het aardige van zo'n plat tekstbestand is dat allerlei programma's (ook Apple software) ermee overweg kunnen.
Het versturen van een tekstbestand is ook nergens een probleem.
 
Das waar idd. Alleen ben je wel iedere vorm van opmaak kwijt en wat ik me ook af vraag is wat er gebeurd als er geen G: bestaat?
Ik zit er nu aan te denken om een "werk(tab)blad" toe te voegen die in 3 stappen het gewenste resultaat op levert, met een eenvoudige korte uitleg omtrent de stappen.
Zal m hier posten, mocht er toch een niet VBA oplossing zijn hoor ik het graag natuurlijk ;-)
 
Ik vond de opmaak sowieso al niet indrukwekkend. Mijn suggestie behoudt in ieder geval 100% de (ontbrekende) opmaak uit het voorbeeldbestand.
Het is handig in een draad niet bij iedere stap nieuwe criteria te formuleren. Dat gebeurt te vaak.
 
Sorry, ben even "uit de running" geweest..

snb, de opmaak in nu niet indrukwekkend idd, dat komt doordat dit een proefbestandje is, anders komen er gegevens in te staan die niet vrij gegeven mogen worden.
"nieuwe criteria", ik snap wat je bedoeld, zal het in gedachte houden.

Besloten is toch met macro's aan de slag te gaan omdat zonder blijkbaar niet mogelijk is, die van VenA werkt prima in de test omgeving dus dat zal de basis worden.

Code:
Sub VenA()
Dim j As Long, jj As Long, t As Long, ar, ar1
With Sheets("rapportage")
    .Cells(1).CurrentRegion.ClearContents
    For Each sh In Sheets(Array("Blad1", "Blad2"))
        ar = sh.Cells(1).CurrentRegion.Resize(, 3).Offset(, 10)
        ReDim ar1((UBound(ar) - 1) * UBound(ar, 2))
        ar1(t) = sh.Name & ":"
        For j = 1 To UBound(ar, 2)
            For jj = 2 To UBound(ar)
                t = t + 1
                ar1(t) = ar(jj, j)
            Next jj
        Next j
        .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(ar1) + 1) = Application.Transpose(ar1)
        t = 0
    Next sh
    .Cells(1).Delete Shift:=xlUp
End With
End Sub

Ik ga kijken of ik per regel begrijpelijk kan krijgen voor mezelf wat er gebeurd zodat ik hem kan aanpassen aan het uiteindelijke bestand.
VenA, is het voor jou veel werk om wat uitleg te geven over wat de stappen van het macro zijn, wat ze doen?

gr Ivo
 
Laatst bewerkt:
Ik kan totaal niet lezen wat er zoal staat. Dus enige verklaring kan ik dan ook niet geven. Gebruik de ingebakken opties in de VB-Editor om code te 'debuggen'.
 
excuses, had de code als tekst ingevoegd.
Het gaat om de door jou aangereikte code. Ben nu bezig met een poging tot "debuggen" idd, maar valt niet mee.. :)
 
Status
Niet open voor verdere reacties.

Nieuwste berichten

Terug
Bovenaan Onderaan