Macro alle tabbladen samenvoegen met behoud van opmaak

[Tweety1]

Ben opzoek naar een Macro die alle tabbladen samenvoegt en dit plaats in sheet achteraan met de naam Totaal. Tabbladen Controle en Docent mag hij niet mee nemen (staan achteraan)



Ik vond wel de macro maar weet niet hoe ik deze verder kan aanpassen.

Sub TotaalBlad()

    Worksheets.Add before:=Sheets(1)
    Sheets(1).Name = "TOTAAL"
    
    For i = 2 To Sheets.Count
        With Sheets(i)
            .Range("A1:K" & .Range("B" & Cells.Rows.Count).End(xlUp).Row).Copy _
                Sheets(1).Range(Cells(Rows.Count, 1).End(xlUp).Offset(IIf(Sheets(i).Index = 2, 0, 1)).Address)
        End With
    Next i

End Sub

mvg

Kasper

 

[Cobbe]

Probeer deze aanpassing eens:

Sub TotaalBlad()

    Worksheets.Add before:=Sheets(1)
    Sheets(1).Name = "TOTAAL"
    For i = 2 To Sheets.Count
        With Sheets(i)
         If Not Sheets(i).Name = "Controle" And Not Sheets(i).Name = "Docent" Then
            .Range("A1:K" & .Range("B" & Cells.Rows.Count).End(xlUp).Row).Copy _
                Sheets(1).Range(Cells(Rows.Count, 1).End(xlUp).Offset(IIf(Sheets(i).Index = 2, 0, 1)).Address)
         End If
        End With
    Next i

End Sub

 

[Tweety1]

De aanpassing werkt. Heb zelf nog iets toegevoegd zodat her werbblad na het einde wordt verplaats. Is dat ook mogelijk zonder die extra regels (Na Next i)
Kopieer gedeelte gaat goed omdat hij rekening met kolom B houdt (A is niet altijd gevuld en B wel) hoe los ik dit op bij het plakken?

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 = "Controle" And Not Sheets(i).Name = "Docenten" Then
            .Range("A1:K" & .Range("B" & Cells.Rows.Count).End(xlUp).Row).Copy _
                Sheets(1).Range(Cells(Rows.Count, 1).End(xlUp).Offset(IIf(Sheets(i).Index = 2, 0, 1)).Address)
         End If
        End With
    Next i
    ActiveSheet.Move _
       After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
End Sub

mvg

Kasper

 

[snb]

Duik eens iets meer in de code zelf, regel per regel. ( F8 )
Kijk wat iedere regel doet ; breng verandering in zo'n regel aan en kijk naar het verschil in resultaat; gebruik de hulpbestanden van de VBEditor (F1) en de 'Object Browser' van de VBEditor (F2).
Naarmate je meer snapt van de code kun je hem zelf makkelijker aanpassen of liever zelf maken.
Je kunt beter code schrijven dan code 'vinden'.

 

[Cobbe]

Goede raad van snb moet je zeker niet in de wind slaan.

Ik heb voor deze keer uw code aan uw wensen aangepast, loop ze door via F8 en zie of het goed is:

Sub TotaalBlad1()
  Worksheets.Add after:=Sheets(Sheets.Count)
   Sheets(Sheets.Count).Name = "TOTAAL"
    For i = 1 To Sheets.Count
        With Sheets(i)
         If Not Sheets(i).Name = "Controle" And Not Sheets(i).Name = "Docenten" And Not Sheets(i).Name = "TOTAAL" Then
            .Range("A1:K" & .Range("B" & Cells.Rows.Count).End(xlUp).Row).Cut _
                Sheets("TOTAAL").Range(Cells(Rows.Count, 1).End(xlUp).Offset(IIf(Sheets(i).Index = 2, 0, 1)).Address)
         End If
        End With
    Next i
End Sub

Vermits je de regels telt van kolom B loopt het ook goed indien kolom A niet altijd gegevens bevat.

 

[snb]

@Cobbe

Sub M_snb()
  With Sheets.Add(Sheets(Sheets.Count))
     .Name = "TOTAAL"
     For Each sh In Sheets
         If InStr("_Controle_Docenten_TOTAAL_", "_" & sh.Name & "_") = 0 Then sh.Cells(1).CurrentRegion.Cut .Cells(Rows.Count, 1).End(xlUp).Offset(1)
     Next
  End With
End Sub

 

[Cobbe]

Dat bedoel ik nu !!

 

[Tweety1]

Allemaal erg bedankt. SNB. Bedankt voor de tip. Ben pas begonnen om Macro te maken.