Helpmij.nl
Helpmij.nl
Helpmij.nl

Quote

Weergeven resultaten 1 tot 5 van 5

Onderwerp: Macro tabbladen samenvoegen en formule toevoegen

  1. #1
    Vraag is opgelost

    Macro tabbladen samenvoegen en formule toevoegen

    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
    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)

  2. #2
    Senior Member
    Geregistreerd
    16 december 2016
    Probeer eens:

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

  3. #3
    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 aangepast door freestyler2 : 29 juni 2020 om 17:47

  4. #4
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    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 aangepast door VenA : 29 juni 2020 om 23:34
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  5. #5
    Werkt perfect, dank!

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl

Regels
Help

Helpmij.nl en business

Partners
Sponsoren