VBA Samenvoegen Tabbladen alleen lay-out & waarde meenemen

[Borrie82]

Hoi,

Zou iemand mij met onderstaande kunnen helpen? Ik wil dat zodra er op de knop "Totaal" gedrukt wordt, dat alleen de waarde en lay-out mee worden genomen uit de overige tabbladen zonder de formules. (de code is overigens niet van mij, heb deze aan mijn situatie aangepast)

Alvast bedankt!


Sub TotaalBlad1()

Worksheets.Add before:=Sheets(1)
Sheets(1).Name = "TOTAAL"
For i = 2 To Sheets.Count
With Sheets(i)
If Not Sheets(i).Name = "Data" And Not Sheets(i).Name = "Weken" Then
.Range("A1:AT38" & .Range("A" & Cells.Rows.Count).End(xlUp).Row).Copy _
Sheets(1).Range(Cells(Rows.Count, 1).End(xlUp).Offset(IIf(Sheets(i).Index = 1, 0, 1)).Address)
End If
End With
Next i
ActiveSheet.Move _
After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
End Sub

 

[A4papiertje]

Het handigste is denk ik als je een voorbeeld bestand upload hier, dan kan men zich de situatie een beetje inbeelden.

Zoals ik het nu zie: Je voegt een tabblad toe en wil deze "TOTAAL" noemen. Je wil van alle tabbladen behalve "Data" en "Weken" een bereik kopiëren en plakken in het tabblad "TOTAAL"?

 

[VenA]

Probeer het zo eens

Sub VenA()
If IsError(Evaluate("TOTAAL!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = "TOTAAL"
With Sheets("TOTAAL")
    .Cells.Clear
    For Each sh In Sheets
        If sh.Name <> "Data" And sh.Name <> "Weken" And sh.Name <> "TOTAAL" Then
            sh.Range("A1:AT" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Copy .Cells(Rows.Count, 1).End(xlUp).Offset(IIf(.[A1] = "", 0, 1))
        End If
    Next sh
    .Cells.Copy
    .Cells.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End With
End Sub

Als het een aaneengesloten bereik is kan je ook dit gebruiken

sh.Cells(1).CurrentRegion.Copy

Nb. Gebruik svp codetags.

 

[Borrie82]

Fantastisch hier was ik naar op zoek! Bedankt voor je hulp