Opgelost Werkbladen samenvoegen

[DeArie]

Ik ben al een poos aan het zoeken om mijn werkbladen samen te voegen aan de hand van de naam van het werkblad en op datum ( deze staat in cel B4)


Nu doe ik dit handmatig met de volgende code ( waarbij ik dan zelf kijk welk werkblad het oudst is )

Sub WerkbladenSamenvoegenLinks()

Application.ScreenUpdating = False

Range("B4").Copy
    ActiveSheet.Previous.Select
    Range("B4").Select
    ActiveSheet.Paste
    ActiveSheet.Next.Select

ActiveSheet.Select
Range("A1048576").Select
Selection.End(xlUp).Select
lastrow1 = ActiveCell.Row

Range("A10:J" & lastrow1).Select
Selection.Copy
ActiveSheet.Previous.Select

Range("A1048576").Select
Selection.End(xlUp).Select
lastrow2 = ActiveCell.Row + 1

Range("A" & lastrow2).Select
Selection.Insert Shift:=xlDown

Range("A:J").EntireColumn.AutoFit

ActiveSheet.Next.Select

Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

ActiveSheet.Previous.Select
    
End Sub

Wat ik dus zoek is als er in het geopende bestand twee werkbladen zijn met dezelfde naam dat deze samengevoegd wordt en dat de oudste onder de andere ingevoegd wordt

Is dit mogelijk?

 

[AHulpje]

Twee werkbladen met dezelfde naam is gelukkig niet mogelijk, waarschijnlijk bedoel je werkbladen met hetzelfde klantnummer in de naam? Kunnen er meer dan twee werkbladen "met dezelfde naam" in het document voorkomen? Verder kloppen de datums "Vanaf" en "Tot en met" niet met de datums in kolom A.

 

[cow18]

zoiets ?

Sub Dubbel()
     Dim sh, SH1 As Worksheet, Naam As String, r
     Application.ScreenUpdating = False

     For Each sh In ThisWorkbook.Worksheets  'alle tabbladen aflopen
          If sh.Name Like "* (#)" Then       'naam eindigt met spatie en een cijfer tussen haakjes
               Naam = Left(sh.Name, Len(sh.Name) - 4)     'naam zonder dat laatste
               On Error Resume Next
               Set SH1 = Nothing
               Set SH1 = Worksheets(Naam)    'bestaat dat tabblad al
               On Error GoTo 0

               If SH1 Is Nothing Then        'tabblad bestaat niet
                    sh.Name = Naam           'huidi tabblad hernoemen zonder dat achtervoegsel
               Else
                    sh.UsedRange.Copy        'inhoud blad kopieren
                    With SH1
                         If .FilterMode Then .ShowAllData
                         r = Application.Max(.Range("A" & Rows.Count).End(xlUp).Row, .Range("J" & Rows.Count).End(xlUp).Row) + 5
                         .Range("A" & r).PasteSpecial xlAll     'plakken onder bestaande
                    End With

                    Application.DisplayAlerts = False
                    sh.Delete
                    Application.DisplayAlerts = True
               End If
          End If
     Next
    
     Application.CutCopyMode = False
     Application.Goto ActiveCell

End Sub

 

[DeArie]

AHulpje, Je hebt helemaal gelijk ( uitleggen is niet mijn sterkste kwaliteit ) het gaat inderdaad over de klantnummers in de naam zijn altijd de eerste 6 cijfers. En nee maximaal komt in het bestand twee keer hetzelfde klantnummer voor. en wat betreft de datums heb je ook gelijk in dit is ook maar een voorbeeld bestand normaal past dat zichzelf aan heb nu alleen de oudste datum aangepast.

 

[DeArie]

Beste cow18,

dankjewel ben ermee bezig geweest maar krijg hem niet werkende. Moet ik nog iets specifieks aanpassen?

 

[AHulpje]

Zie Sub Samenvoegen

 

[cow18]

AHulpje voegt de tabbladen met dezelfde 6 eerste nummers samen, ik kijk naar de volledige naam en naar het suffix " (#)" en ga daarmee aan de slag. Dus welke piste is de beste ????
Bovendien zou ik vooraf de tabbladen alfabetisch rangschikken (moet desnoods niet fysiek als dat hinderlijk is) om zo te kunnen chronologisch toe te voegen binnen een tabblad.

 

[DeArie]

Beste Cow18, ik had inderdaad al wel begrepen dat jij naar de volledige naam en suffix keek maar in eerste instantie liep de code helemaal niet bij mij. Nu met dit bestandje erbij doet hij het inderdaad wel.
Bedankt ook voor de uitleg erbij!

Op dit moment werkt de code van Ahulpje precies zoals ik voor ogen had. dus ga die nu wel gebruiken

Mag ik jullie beide bedanken!

 

[DeArie]

Ik loop nog tegen een probleempje aan als er vanaf rij 10 maar 1 ingevulde rij is krijg ik storing.

Fout 1004 tijdens uitvoering
U kunt dit hier niet plakken omdat het gebied voor
kopiëren en plakken niet dezelfde grote heeft.
Selecteer één cel in het plakgebied of selecteer een gebied
met dezelfde grote en plak de gegevens opnieuw


Sheets(sheetNaar).Rows(rnaar).Insert

Kleurt dan geel.

Kan dat nog aangepast worden?

 

[snb]

Zelfstandig naamwoord: de grootte
Bijvoeglijk naamwoord of bijwoord: groot of grote

 

[emields]

Sheets(sheetVan).Range(Sheets(sheetVan).Rows(10), Sheets(sheetVan).Rows(100).End(xlup)).Copy

 

[AHulpje]

@snb
Er worden inderdaad veel spel- en schrijffouten gemaakt, en daar mag je je aan ergeren, maar dan liefst wel in stilte. Niet iedereen is zo goed als jij, ook al schrijf je zelf "Vermijd ten alle tijde samengevoegde cellen." in topic
https://www.helpmij.nl/forum/thread...ters-toe-te-voegen.970867/page-2#post-6380459
Dus liever niet meer op de man spelen maar blijf wel je zeer uitgebreide kennis betreffende Excel delen, dat wordt zeer gewaardeerd.

 

[DeArie]

@AHulpje het ergste is dat ik het dan nog verkeerd heb over genomen ook aangezien het wel zoals beschreven door snb in de foutmelding stond... dom van me....

@emields, dat werkt inderdaad als er in 1 werkblad 1 regel staat helaas niet als in beide werkbladen maar 1 regel staat... Dan krijg ik wederom dezelfde foutmelding....

 

[AHulpje]

Kleine wijziging in Sub Combineren:

Sub Combineren(sheetVan, sheetNaar)
    rnaar = Sheets(sheetNaar).Rows(Cells.Rows.Count).End(xlUp).Row + 1
    Sheets(sheetVan).Range(Sheets(sheetVan).Rows(10), Sheets(sheetVan).Rows(Cells.Rows.Count).End(xlUp)).Copy
    Sheets(sheetNaar).Rows(rnaar).Insert
    Sheets(sheetNaar).Range("B4") = Sheets(sheetVan).Range("B4") 'Datum aanpassen
    Application.DisplayAlerts = False
    Sheets(sheetVan).Delete
    Application.DisplayAlerts = True
End Sub

 

[snb]

@AHulpje
Ik speel niet op de man/vrouw maar op de taal.
Mijn spelfouten wil ik graag verbeteren, maar krijg daarvoor op dit forum na 60 minuten niet meer de gelegenheid.
De afgelopen week was het wel héél gortig met slordig denken en het daarmee samenhangende taalgebruik.
Zoals je kunt zien heb ik niet op al die bijdragen gereageerd.
Het getuigt van respekt voor de helpers hier als een vraagsteller moeite doet een vraag helder en correct te formuleren en niet zomaar wat kreten zonder leestekens op een scherm te flansen.
Wil je als kwalitatief forum worden beschouwd dan is taal daarbij essentieel.

 

[DeArie]

@AHulpje Dankjewel dit doet precies wat ik voor ogen had.

@snb Is het slordig denken? Niet iedereen is goed in op de juiste manier uitleg geven over iets waar ze nauwelijks verstand van hebben en het dan ook nog eens juist te formuleren, maar willen wel graag geholpen worden om hun probleem op te lossen. Dat is in geen enkel opzicht respectloos bedoelt in mijn ogen in elk geval.

Aan iedereen die mij in dit geval geholpen heeft dank jullie wel!

 

[emields]

De makkelijkste manier om bladen samen te voegen is alles op 1 blad te zetten en daar dan uit te halen wat je wil.