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

Macro tabbladen samenvoegen en formule toevoegen

Status
Niet open voor verdere reacties.
F

freestyler2

Gebruiker
Lid geworden
5 mrt 2008
Berichten
63
Ik wil meerdere tabbladen samenvoegen tot 1 tabblad. Om onderscheid te maken tussen de verschillende tabbladen dient de oorspronkelijke tabbladnaam te worden toegevoegd aan het samengevoegde tabblad. Tot zover geen probleem :rolleyes:
Het probleem ontstaat op het moment dat ik in deze zelfde macro een extra formule wil toevoegen in de laatste lege kolom.

Code: 
Sub tabbladen_samenvoegen_Totaal()
Application.ScreenUpdating = False
Dim i As Long
Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Dim Lastrowd As Long
Sheets.Add(Before:=Sheets(1)).Name = "Totaal"
Lastrow = 6
Lastrowd = 6

    For i = 2 To Sheets.Count
        
        ans = Sheets(i).Name
        Lastrowa = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
        Sheets(i).Range("A18:S" & Lastrowa).Copy Sheets("Totaal").Range("A" & Lastrow)
        Lastrowd = Sheets("Totaal").Cells(Rows.Count, "A").End(xlUp).Row
        Sheets("Totaal").Range("T" & Lastrow & ":T" & Lastrowd).Value = ans
        Lastrow = Sheets("Totaal").Cells(Rows.Count, "A").End(xlUp).Row + 1
        Cells.Select
        Cells.EntireColumn.AutoFit
        
    Next
Application.ScreenUpdating = True
End Sub

Nu wil ik in dezelfde macro in kolom U de formule =DEEL(D1;1;6) toevoegen maar ik kom er niet helemaal uit. Wie kan mij verder op weg helpen?

Code: 
Sheets("Totaal").Range("U" & Lastrow & ":U" & Lastrowd).Value = MID(RC[-17],1,6)
 
Probeer eens:

Code: 
Sheets("Totaal").Range("U" & Lastrow & ":U" & Lastrowd).Value = "=MID(RC[-17],1,6)"
 
Wauw zo simpel kan het zijn :)

Het probleem is opgelost, bedankt voor de hulp!

Als aanvulling daarop: Is het ook mogelijk om ipv een nieuw tabblad (Totaal) aan te maken, de huidige inhoud in het tabblad te vervangen? Zodat je niet elke keer handmatig het tabblad hoeft te verwijderen en opnieuw de macro uitvoeren (ivm anders een dubbele waarde tabblad)?
 
Laatst bewerkt:
Zou zoiets het ook niet doen. Geen voorbeeld dus niet getest.

Code: 
Sub VenA()
  If IsError(Evaluate("Totaal!A1")) Then Sheets.Add(Sheets(1)).Name = "Totaal"
  With Sheets("Totaal")
    .Cells.Clear
    For Each sh In Sheets
      If sh.Name <> .Name Then
        sh.Range("A18:S" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Copy .Cells(Application.Max(6, .Cells(Rows.Count, 1).End(xlUp).Row), 1)
        .Range("T" & Application.Max(6, .Cells(Rows.Count, 20).End(xlUp).Row) & ":T" & .Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 2) = Array(sh.Name, "=MID(RC[-17],1,6)")
      End If
    Next sh
  End With
End Sub

Ipv Mid kan je net zo goed Left gebruiken.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan