Automatische transfer van sheet 1,2, 3 etc naar een db sheet

[vacances2000]

Beste
Ik ben aan het uitvogelen hoe ik bovenstaande in de titel kan verwerkt krijgen.

Sheet 1, 2, 3 tot en met 30 zijn template sheets met elk een andere benaming van een ander bedrijf maar zelfde layout/ titel in rij1. De uiterst rechtse sheet zou een database moeten zijn die de gegevens van sheet 1 t/m 30 overneemt 1 voor 1. Bij het woordje stop in kolom B slaat de tranfer over naar de volgende sheet.

In bijgevoegd voorbeeld is de tekst uit sheet 1 en 2 onder elkaar geplakt. bedoeling is dit via een formule of anderzins voor elkaar te krijgen dan kopieren/ plakken.

Bekijk bijlage Book1.xlsx

Bedoeling is dus het dynamish te doen en niet kopiëren / plakken..

Iemand die een idee heeft hoe hiermee om te gaan?

Hartelijk voor de medewerking.

Jonathan

 

[pasan]

Er zitten beperkingen aan, zoals geen rekening houdend met mogelijke lege regels
En je zou nu meerdere keren de zelfde gegevens van elk blad naar het blad "data" kunnen overbrengen

Sub transfer()
For i = 1 To Sheets.Count
  If Sheets(i).Name = ("data") Then Exit For
   Rnumber = Application.WorksheetFunction.Match("stop", Sheets(i).Columns(2), 0)
   Knumber = Sheets(i).Cells(1, Columns.Count).End(xlToLeft).Column
   
   With Sheets("data")
     N = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(N, 1).Resize(Rnumber - 2, Knumber).Value = Sheets(i).Cells(2, 1).Resize(Rnumber - 2, Knumber).Value
   End With
Next
End Sub

 

[vacances2000]

Beste Pasan,
Hartelijk dank voor je hulp nogmaals

Zie de bijgevoegde bijlage. ik krijg een melding dat ik het als macro op moet slaan? Ik snap er niet veel van in ieder geval gezien dit een stapje te ver voor me gaat )

Hoe kan ik dit oplossen?

Vriendelijke Groet
Jonathan

 

[Warme bakkertje]

Dit betekent dat je je bestand moet opslaan als xlsm ipv xlsx zodat de code behouden blijft.

 

[vacances2000]

Bedankt Rudi.

Het werkt nu inderdaad.

Alléén bij macro opnieuw uitvoeren, worden de oude lijnen niet verwijderd.. Is het makkelijk een refresh functie of soortgelijk in te Hartelijk bouwen?

Dank

Jonathan

 

[pasan]

Wat moet er gebeuren als het woordje "stop" niet ergens in kolom B voorkomt?
Als het woordje "stop" wel voorkomt wordt tot deze regel eerst verplaatst naar blad "data" en daarna alle regels verwijderd tot en met regel "stop" en alles onder deze regel blijft bewaard.
Als het woordtje "stop" niet voorkomt wordt alles verplaatst en verwijderd
Probeer maar eens

Sub transfer()
For i = 1 To Sheets.Count
  If Sheets(i).Name = ("data") Then Exit For
   On Error Resume Next
   Rnumber = Application.WorksheetFunction.Match("stop", Sheets(i).Columns(2), 0)
   Knumber = Sheets(i).Cells(1, Columns.Count).End(xlToLeft).Column
    With Sheets("data")
     N = .Cells(Rows.Count, 1).End(xlUp).Row + 1
     .Cells(N, 1).Resize(Rnumber - 2, Knumber).Value = Sheets(i).Cells(2, 1).Resize(Rnumber - 2, Knumber).Value
    End With
    Sheets(i).Cells(2, 1).Resize(Rnumber - 1, Knumber).Delete Shift:=xlUp 
Next
End Sub

 

[vacances2000]

Beste,
Ik heb de nieuwe code geprobeerd maar krijg error 400. De oude code werkt ook niet meer op eens.

Andere bijkomende de vraag: maakt de lengte van de rij nog uit? Nu zijn de kolommen A t/m D voor het voorbeeld gebruikt. In het bestand waar het uiteindelijk om gaat, gaat het om rij A t/m BM.

Dank
Jonathan

 

[pasan]

zoals de code nu is doen alle kolommen mee vanaf kolom 1 tot en met de laatste ingevulde cel in de eerste rij
de code begint te kijken in de eerste rij van uit de allerlaatste kolom op je werkblad kolom XFD van hieruit kijkt de code naar links naar elke cel in de eerste rij tot er een ingevulde cel gevonden wordt.
de desbetreffende kolom van de eerst gevonden ingevulde cel bepaald het gebruikte bereik om te verplaatsen naar het blad "data"
plaats jou bestand waarmee jij die foutmelding krijgt

 

[vacances2000]

Beste,
Doet de code het ook bij Excel 2013?

Maak het nog uit hoe je de sheets noemt? of moeten ze sheet 1 2 3 etc blijven?

ALs ik de macro uitvoer op Excel 2010, blijf ik de error 400 houden maar hij doe het op zich wel. Hoe kan ik dit oplossen?



Alvast dank,
JOnathan

 

[Warme bakkertje]

Zolang je Datablad uiterst rechts blijft speelt het geen rol hoe de Sheets heten. De macro werkt sowieso perfect in XL2013.
Zitten er lege regels tussen de gegevens op de Templatesheets ?
Moeten de gegevens ook uit de Templatesheets verwijderd worden na het overzetten of bedoel je met het refreshen enkel het verwijderen van de oude gegevens op blad Data ?

 

[vacances2000]

Beste
Reactie op de 2 vragen:
Zitten er lege regels tussen de gegevens op de Templatesheets ?
Nee, elke rij bevat ten minste in kolom A en B gegevens tot de lege regel waar "stop" staat.

Moeten de gegevens ook uit de Templatesheets verwijderd worden na het overzetten of bedoel je met het refreshen enkel het verwijderen van de oude gegevens op blad Data ?

Nee, de gegevens moet bewaard blijven.

Ik heb de eerste code uitgeprobeerd op het bestand waar het voor zou moeten werken. Helaas krijgen telkens weer die error 400. Ik heb filters verwijderd, enige wat in de laatste rij nog overblijft is "stop", wel zit er nog een kolom gefreezed.
Wel nog even aangegeven dat waaneer ik VB open ik en in het lijstje van sheets kijk, er vermeld staat sheet 1 (naam bedrijf), sheet 2 (naam bedrijf), sheet 3 (naam bedrijf), sheet 4 (naam bedrijf) tot sheet 23 .. dan sheet 24 (database) en dan gaat het weer door met sheets en bedrijfsnamen .. ligt het daaraan misschien? Hoe de positie van de database sheet te veranderen?

Ik hoor het graag.

Vriendelijke groeten

Jonathan

 

[Warme bakkertje]

uiterst rechtse sheet zou een database moeten zijn

Nu 10 antwoorden verder ga je dan vertellen dat deze sheet zich tussen de andere sheets bevindt.

ligt het daaraan misschien?

MEER DAN WAARSCHIJNLIJK WEL :shocked::shocked::shocked:

Rechtsklik op de databasetab en selecteer Verplaatsen of kopieëren. Helemaal onderaan kies je dan Naar einde gaan. Klik OK

 

[vacances2000]

Nop.. vooralsnog was het een oefenbestand waar het wel werkte alles wat u zei Warme Bakkertje ;-) nu het laatste was op het ware bestand. Ik zal het andere uitproberen en kom bij u terug.

Thanks

Jonathan

 

[Warme bakkertje]

Verwijder dan wel deze regel

 Sheets(i).Cells(2, 1).Resize(Rnumber - 1, Knumber).Delete Shift:=xlUp

want anders worden de gegevens op je Templatesheets verwijderd bij het overzetten.

Of test alles op een kopie van je werkelijke bestand.

 

[vacances2000]

Beste,
Ik heb ditmaals een bestand toegevoegd met iets minder dan dertig sheets. De eerste sheet is ongeveer hoe een werkelijke tab eruit zal zien X 25. Ik kan hier geen macro's (.xlsm) uploaden dus helaas kunt het echte ook niet zien. Echter krijg ik dus nog steeds de error 400 met het voorbeeld zoals in sheet 1 ondanks alles te hebben uitgeprobeerd dat u mij moet liet weten.

Ik hoor het graag.

Vriendelijke groeten,

Jonathan

 

[VenA]

Je kan hier prima een .XLSM uploaden. Als deze te groot is kan je het bestand ook eerst opslaan als .XLSB.

 

[Warme bakkertje]

Deze werkt prima.

 

[vacances2000]

Beste Rudi,
Dank voor de file. Deze werkte 1 keer. Bij het aanpassen van bepaalde gegevens van algemeen naar tijd. Liep het echter weer mis, en doet ie het helemaal niet meer.

Enig idee?

Dank voor uw hulp.

Jonathan

 

[VenA]

Is het nu zo moeilijk om dan even het bestandje terug te plaatsen met de wijzigingen die je gedaan hebt?

 

[vacances2000]

Beste,
Ik moet nu een andere oplossing vinden. Een macro is mooi, maar ik heb er schijnbaar niet veel kans van slagen mee.

Is er iets met formules voorhanden of pivot table? Ik dacht dat een multiple consolidation pivot een oplossing kon zijn indien er natuurlijk meerdere labels zoals bij een enkelvoudige pivot kunnen toegevoegd worden...

Punt is er moet gesorteerd kunnen worden in rij labels op Keten/ Taak/ overige zaken en in kolom labels op Week... of andersom..

Indien iemand een formule voorhanden heeft waarmee je tabnamen kunt aangeven in je formule zou dit ook willen uitproberen.

Vriendelijke groeten,
Jonathan