Samenvoegen werkbladen met waarden

Status
Niet open voor verdere reacties.
C

corel

Gebruiker
Lid geworden
15 okt 2008
Berichten
10
Uit een ander (gesloten) draadje vond ik de volgende code voor het samenvoegen van werkbladen:

Code: 
Sub VenA()
With Sheets("TotaalOverzicht")
For Each sh In Sheets
If sh.Name <> "TotaalOverzicht" Then sh.Cells(1).CurrentRegion.Offset(1).Copy .Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next sh
.Cells(1).CurrentRegion.Sort .[A1], , , , , , , True
.Columns.AutoFit
End With
End Sub

Dit werkt op zich goed maar ik heb veel formules in de werkbladen staan, deze code plakt niet de 'value' maar de formule.

Ik ben zelf al aan het proberen geweest met .PasteSpecial Paste:=(xlValues) maar krijg het niet goed.

Zie ook het bestand Bekijk bijlage TEST.xlsm
 
Maak er eens dit van:
Code: 
Sub VenA()
    With Sheets("TotaalOverzicht")
        For Each sh In Sheets
            If sh.Name <> "TotaalOverzicht" Then sh.Cells(1).CurrentRegion.Offset(1).Copy .Cells(Rows.Count, 1).End(xlUp).Offset(1)
        Next sh
        .Cells(1).CurrentRegion.Sort .[A1], , , , , , , True
        .Columns.AutoFit
        For Each cl In Range(.Cells(1).CurrentRegion.Address)
            If cl.HasFormula Then cl.Value = cl.Value
        Next cl
    End With
End Sub

Let ook op je inspringpunten.
 
Laatst bewerkt:
Jouw blad heet Totaalovezicht en krijg je dubbelingen in het resultaat, De gegevens beginnen in A1 en moet je dus geen offset(1) gebruiken. Het cel voor cel kopiëren naar waarden is niet de meest snelle methode.

Code: 
Sub VenA()
  With Sheets("Totaaloverzicht")
    For Each sh In Sheets
      If sh.Name <> "Totaaloverzicht" Then
        sh.Cells(1).CurrentRegion.Copy
        .Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlValues
      End If
    Next sh
    .Cells(1).CurrentRegion.Sort .[A1], , , , , , , True
    .Columns.AutoFit
  End With
End Sub

of
Code: 
Sub VenA1()
  With Sheets("Totaaloverzicht")
    For Each sh In Sheets
      If sh.Name <> "Totaaloverzicht" Then sh.Cells(1).CurrentRegion.Copy .Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next sh
    .UsedRange = .UsedRange.Value
    .Cells(1).CurrentRegion.Sort .[A1], , , , , , , True
    .Columns.AutoFit
  End With
End Sub
 
Ik heb alleen het idee dat het na x werkbladen stopt. Ik heb namelijk een ander bestand waar ik dit op wil uitvoeren met wel 45 werkbladen of meer.
 
Dat kan niet.
Wat wel kan is dat de lengte van kolom A korter is dan de rest van de kolommen, en dan worden waarden overschreven.

Overigens:
Code: 
If sh.Name <> .Name Then
 
Eigenlijk werkt het wel goed, ik heb alles nageteld en het lijkt wel te kloppen. Alleen omdat ik in de eerste
twee werkbladen 'bronnen' heb staan voor de formules, is het allemaal een beetje rommelig.

Is er een mogelijkheid om de eerste twee werkbladen uit te sluiten?
In mijn geval hebben die altijd de naam 'rubr' en 'index'
Alle overige werkbladen hebben de naam 'B2', 'B3', etc

Mocht het verder niet kunnen aangepast dan ben ik al dik tevreden. bedankt voor de hulp.
 
Lijkt mij niet zo'n grote aanpassing.
Code: 
If left(sh.name,1) = "B" then
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan