Generering af tabel fra flere faneblade?

Hej

Der er flere måder enten via links, som udføres manuel eller via VBA
Hvis det skal være VBA/makro skal vi vide følgende

Antal ark?, er det alle ark i filen, undtagen hovedfilen?
hvor ligger din dataer? (celler)

Hej

Jer er størst tilhænger af automatisering :-) så gerne en VBA/Makro.

Der er 48 budget faneblade, og herudover en række andre faneblade, så det er ikke alle ark i filen. Budgetfanebladene adskiller sig ved at være navngivet i en bestemt nummer rækkefølge fra "1000" til "1306".

Hver enkelt budgetark er opbygget på samme måde med kolonnerne: Element, Leverandør, Fakturanr., Kontonr., Dato, Fritekst, Budget, Faktura. Selve tabellens rækker starter i C14 og slutter i J51. Dato-kolonnen ligger i kolonne G.

Håber dette gav dig de svar du behøvede?

/arentoft

Har du et eksemple på et ark navn (Budget)

Ja - "1000"

OK !, :o)  Jeg kigger på det

Prøv dette, skal ligge på det ark du ønsker opdateret
Så finpudser jeg i mellemtiden

Private Sub CommandButton1_Click()
       
    rk = 2                              ' start række
    For Each Skema In Worksheets      ' for hver skema med 1
        If Left(Skema.Name, 1) = "1" Then
            ActiveSheet.Range("C" & rk & ":J" & rk + 37).Value = Skema.Range("C14:J51").Value
            rk = rk + 37
        End If
    Next Skema
End Sub

37 skal ændres til 38

Det begynder at ligne noget - hvordan får jeg det så månedskontrollen med?

øøøh, hvilken månedskontrollen? :o)

Hvor ligger den?, og hvor skal den hen?

I mit første indlæg skrev jeg: "På tværs af disse faneblade vil jeg gerne have et faneblad der samler alle posteringer for en given måned i en ny tabel, med én række pr. postering."

Altså vil jeg lave et faneblad pr. måned det samler alle posteringer på tværs af alle budgetfaneblade for en given måned, ud fra den datokolonne der er i budgetarkene.

Som det fungerer lige nu syntes jeg den også kopiere tomme linjer med - jeg vil kun have de linjer med der opfylder den rette måned.

/arentoft

Har du mulighed for at sende en kopi af filen?

Jacob,lemming(a)Honeywell,com
,=.
(a)=@

Den er på vej ... :-)

Resulatet blev:

Sub FindPoster()
    manedtabel = Array("", "Jan", "Feb", "Mar", "Apr", "Maj", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dec")
    rk = 4 ' start række i modtager ark
    rkdata = 14 'start række i data ark
    rkdataslut = 51 'slut række i data ark
   
    For Each Skema In Worksheets ' for hver skema med 1
        If Left(Skema.Name, 1) = "1" Then
            For manednr = 1 To 12  ' Find måned
                If manedtabel(manednr) = Left(ActiveSheet.Name, 3) Then Exit For
            Next manednr
            For t = rkdata To rkdataslut    ' find rækker og flyt
            If Month(Skema.Cells(t, "G")) = manednr And Skema.Cells(t, "G") <> Empty Then
                ActiveSheet.Range("A" & rk & ":J" & rk).Value = Skema.Range("D5").Value
                ActiveSheet.Range("B" & rk & ":I" & rk).Value = Skema.Range("C" & t & ":J" & t).Value
                rk = rk + 1
            End If
            Next t
        End If
    Next Skema
End Sub

Tak for hjælpen!

Husk at accepter mit svar :-)