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

Tabbladen samenvoegen met macro

  • Onderwerp starter Onderwerp starter radar
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
R

radar

Gebruiker
Lid geworden
13 jan 2006
Berichten
242
Excellenties,

Heb ooit macro gekregen, met dank aan Zapatr, die de gegevens van een drietal tabbladen op een blad samenvoegt.
Echter met deze macro wordt op combiblad van elk tabblad de laatste regel niet meegenomen.
De lengte van de te combineren bladen variëren en kunnen ter info wel 80000 regels bevatten van kolom A tm Q
Zal overigens nooit samen het maximaal aantal regels overschrijden.
Hoe krijg ik deze ontbrekende regels meegekopiëerd.
En gelet op de hoeveelheid regels is er misschien een snellere manier ?

Radar
 

Bijlagen

Ik heb er niet erg veel verstand van maar probeer het eens zo.
Code: 
Sub macro1()
Dim x As Integer
Sheets(2).Columns(1).ClearContents
'Deze macro is geschreven door Zapatr
For x = 3 To Sheets.Count
With Sheets(x)
.Range("A1:Q" & .Range("A" & .Rows.Count).End(xlUp).Row [COLOR="#FF0000"]+ 1[/COLOR]).Copy
With Sheets(2)
.Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row [COLOR="#FF0000"]+ 1[/COLOR]).PasteSpecial Paste:=xlPasteValues
.Range("A1").Select
End With
End With
Next x
End Sub
 
Alleen deze regel:
Code: 
.Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
vervangen door
Code: 
.Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
 
Deze code is robuuster:

Code: 
Sub M_snb()
  For Each sh In Sheets
    If Left(sh.Name, 1) = "P" Then
       With sh.Cells(1).CurrentRegion
          Sheets("Combi").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count) = .Value
       End With
    End If
 Next
End Sub

want:
- gebruikt geen 'copy'; en belast daardoor het (vertragende) klembord niet.
- is niet afhankelijk van de indexnummers van werkbladen
- controleert welke werkbladen samengevoegd moeten worden
- gebruikt geen 'select'
- heeft geen 'application.screenupdating=false' nodig
 
Laatst bewerkt:
Dank voor de reacties;

@Excelamateur: aanpassing geeft foutmelding op eerste aangepaste regel.
@Zapatr: alle regels worden nu meegenomen, echter ze worden in combiblad gebundeld vanaf rij 2 en niet vanaf rij 1 zoals voorheen wel het geval was.
Kun je hier nog iets aan doen ?
@SNB: het gaat sec om de 3 bladen na het combi-blad, (in mijn origineel bestand heb ik dat in script ondervangen), de info op de overige tabbladen daarna gaan niet mee in deze actie.
Heb een en ander nog niet getest met jouw macro.
 
Vandaar "Excelamateur" maar zat er niet ver naast.
Ik had ook gemerkt dat hij op regel 2 plakt.
Nu nog de oplossing daarvoor.
 
Aanvulling richting SNB...
Macro werkt wel en sneller;
ik had in origineel bestand tab-namen met kleine letter p geschreven...
Ook jouw macro begint op combiblad op rij 2 te vullen.
Is hier nog oplossing voor ?
 
Natuurlijk moet ikzelf mijn eigen code beter nakijken, maar ik heb nu weinig tijd.
Maar ook: dit zijn erg simpele dingen, waar iedereen met wat nadenken en proberen een oplossing voor moet kunnen vinden.
Ik gebruik er nu 1, maar er zijn er ook andere (en wellicht betere).
Probeer dit:
Code: 
Sub macro1()
Dim a As Integer, x As Integer
Sheets(2).Columns(1).ClearContents
'Deze macro is geschreven door Zapatr
For x = 3 To Sheets.Count
With Sheets(x)
.Range("A1:Q" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy
With Sheets(2)
a = 0: If Not (IsEmpty(Range("A1"))) Then a = 1
.Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row + a).PasteSpecial Paste:=xlPasteValues
.Range("A1").Select
End With
End With
Next x
End Sub
 
Test dit eens, volgens mij doet hij wat je wil.
Code: 
Sub M_snb()
  For Each sh In Sheets
    If Left(sh.Name, 1) = "P" Then
       With sh.Cells(1).CurrentRegion
          Sheets("Combi").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count) = .Value
       End With
    End If
 Next

  With Sheets("Combi")
    Cells(2, 1).CurrentRegion.Cut Destination:=Range("A1")
  End With
End Sub
 
Laatst bewerkt:
@Radar,
die macro hoort in een module hoor, niet 'achter' blad 'combi'.
 
Allen dank voor reacties:

@Zapatr: nieuwe macro doet wat ik graag wou.
@Excelamateur: aanpassing in SNB macro geeft ook gewenst effect.

Op basis van vergelijk laatste twee macro's is macro Zapatr sneller in groot fictief bestand

Ga de macro nu in origineel bestand uitproberen

Dank voor de hulp !

Radar
 
Ondervangt grote en kleine beginletters in tabnaam. Verwijdert lege rij 1
Code: 
Sub M_snb()
  For Each sh In Sheets
    If UCase(Left(sh.Name, 1)) = "P" Then
       With sh.Cells(1).CurrentRegion
          Sheets("Combi").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count) = .Value
       End With
    End If
 Next
 Sheets("Combi").Rows(1).Delete xlUp
End Sub

Op basis van vergelijk laatste twee macro's is macro Zapatr sneller in groot fictief bestand
Klik om te vergroten...
Lijkt mij hoogst onwaarschijnlijk aangezien geen gebruik wordt gemaakt van Copy - Paste
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan