Cellen kopieren van verschillende tabbladen naar 1 tabblad

Status
Niet open voor verdere reacties.
Beste Harry,

Sorry voor het misverstand over rij"A", maar in mijn voorbeeld was die reeds meegenomen, maar inderdaad voor de prullenmand werkt niemand graag '
Ik ben trouwens enorm tevreden over je geleverde werk ! Denk dat er weinige zijn die VBA met zulke kennis :thumb:

Nu ik heb de macro getest, en werkt prima ! Dus we zijn er bijna

Enkel zoals ik reeds in vorige reactie vermeldde, als we de lege rijen verbergen, geeft de macro enkel nog de eerste rij in copy, maar het rare is hij geeft wel de datum perfect in aantallen
Uitleg volgens bv sheet: 13032017A; er zijn 6 rijen te kopieren, als we de lege cellen NIET wegdoen, werkt de Macro PERFECT, als we de lege cellen verwijderen, geeft het enkel rij 1 in copy op "stockbeheer", maar de datum geeft hij wel 6 keer. (Trouwens had foutje gemaakt, moest zijn nietS6 maar S4 maar heb dat zelf kunnen aanpassen Sh.cells(6, 19) veranderd naar (4, 19)

Kan je eens bekijken wat er misgaat bij "lege cellen verwijderen", waarom hij enkel rij 1 nog kopieert ?

Thx alvast

Tom
 
Zo zou het dan goed moeten werken Tom.
Code: 
Range("A22:U" & Application.Max(22, Cells(126, 4).End(xlUp).Row)).Copy
 
Harry,

Om in de toekomst misverstanden te verkomen, kan de macro bekijken of de data die hij wil plakken al aanwezig is in het tabblad STockBeheer (bv: kolom B is een kolom met UNIEKE waarden), en als deze aanwezig is, bv een pop up venster laat verschijnen, "data is al geimporteerd"

Wat ook een leuk extraatje zou zijn is, als de kolom H (Stock) in het tabblad Stockbeheer, op "0" komt, dat dan de gehele rij automatisch verborgen wordt

Maar dit zijn geen NOODZAKEN he, was gewoon een leuk idee

Tom
 
Harry,

Terugkomen op "exportstockbeheer"

Ik kreeg volgende sub van jou, die perfect WERKT !

Sub StockExportHSV()
If ActiveSheet.Name <> "Stockbeheer" Then
If Range("B22") <> "" Then
Application.ScreenUpdating = False
Set Sh = ActiveSheet
Range("A22:U" & Application.Max(22, Cells(126, 4).End(xlUp).Row)).Copy
With Sheets("stockbeheer")
Application.Goto .Cells(Application.Max(14, .Cells(124, 2).End(xlUp).Offset(1).Row), 2)
.Cells(Application.Max(14, .Cells(124, 1).End(xlUp).Offset(1).Row), 1).PasteSpecial -4122
.Paste , True
.Cells(Application.Max(14, .Cells(124, 23).End(xlUp).Offset(1).Row), 23).Resize(Sh.Range("A22:U" & Application.Max(22, Sh.Cells(124, 2).End(xlUp).Row)).Rows.Count) = Sh.Cells(4, 19).Value
End With
Application.CutCopyMode = 0
End If
End If
End Sub

Maar nu wil ik de export doen naar een ander werkblad "Stockbeheer2017" met 1 tabblad "stockbeheer"
Als ik wat ga zoeken in reeds aangeleverde subs, heb ik geprobeerd om volgend in elkaar te steken

Sub TestExportStockbeheer2017()
Dim sh As Worksheet, c As Range
With GetObject(ThisWorkbook.Path & "\StockBeheer2017.xlsm")
.Windows(1).Activate
For Each sh In ThisWorkbook.Sheets
If ActiveSheet.Name <> "#########" Then
With .Sheets("stockbeheer")
If Range("B22") <> "" Then
Application.ScreenUpdating = False
Set sh = ActiveSheet
Range("A22:U" & Application.Max(22, Cells(126, 4).End(xlUp).Row)).Copy
With Sheets("stockbeheer")
Application.Goto .Cells(Application.Max(14, .Cells(124, 2).End(xlUp).Offset(1).Row), 2)
.Cells(Application.Max(14, .Cells(124, 1).End(xlUp).Offset(1).Row), 1).PasteSpecial -4122
.Paste , True
.Cells(Application.Max(14, .Cells(124, 23).End(xlUp).Offset(1).Row), 23).Resize(sh.Range("A22:U" & Application.Max(22, sh.Cells(124, 2).End(xlUp).Row)).Rows.Count) = sh.Cells(4, 19).Value
End With
Application.CutCopyMode = 0

End With
End If
End Sub

Maar werkt niet :(

Kan jij me helpen,
Doelstelling:
Uit de werkmap "inkoopboek" de tabbladen APART kunnen exporteren (alle tabbladen hebben "23032017A" negen karakters, steeds verschillend, daarom had ik geprobeerd in mijn sub "#########"
De export die moet gebeuren is correct met de sub die ik hierboven "geplakt" heb Sub StockExportHSV()
Enkel is de doelmap nu anders geworden ("STOCKBEHEER2017.xlsm) er is maar 1 tabblad ("STOCKBEHEER")

Begrijp je me ?
Anders vraag je meer uitleg he

Tom
 
Je haalt de boel een beetje door elkaar Tom,

werkmap/folder/subfolder
werkboek/bestand
werkblad/tabblad
 
OeiOei, sorry he zal even schetsen voor alle duidelijkheid

Op mijn pc is er:
Een MAP: "ELLEBELLEFASHION"
Daarin zitten volgende bestanden:
* Calculatiemap.xlsm -- Vaste Tabbladen: bussinessplan/commissiegastvrouwen/commisieconsulenten/cumultoverzicht/onkosten2017/verkoopfacturen/enz
* Inkoopboek.xlsm -- Tabbladen: Basisxlt/Inkoopstart-Q1-2017/StartJanuari2017/"dan hier komen steeds extra tabbladen bij, naargelang de inkooporders/Eindjanuari2017/StartFebruari2017/enz
* stockbeheer2017.xlsm -- vast Tabblad: Stockbeheer/
* Inputconsulente.xslm -- Tabbladen: Indien opgemaakt als tabbladen Inkoopboek

Wat wil ik nu:

Uit het "inkoopboek" de tabbladen die bijgevoegd worden (steeds 9 karakters vb:22032017A), de data kopieren (maar die macro bestaat al, heb je vorige week gemaakt en werkt prima), naar de map "Stockbeheer2017" op het tabblad "Stockbeheer"

Ik hoop dat ik het goed heb uitgelegd :)

Tom
 
Code: 
If len(sh.name) = 9 Then

Anders beide bestanden plaatsen als de gegevens op de verkeerde plek komen.
 
harry,

Zit hier al 2 uur te prullen, en kan het niet voor elkaar krijgen, krijg steeds melding end if verwacht, end with verwacht
Heb alles geprobeerd, maar lukt me niet

wat bedoel je met beide bestanden plaatsen ?

testexport.JPG

mag ik anders beide bestanden eens uploaden, zodat je het eens kunt bekijken ?

Tom
 
Als je gebruik maakt van de juiste inspringpunten dan zie je vanzelf waar het fout gaat. Elke With hoort afgesloten te worden met een End With. Hier mis je er dus twee van. Bij een For loop hoort een Next die mis je ook.
 
Harry,

in bijlage de 2 bestanden, zoals ik reeds zei, de juiste macro heb je al in je bezit qua kopieren en layout, (vorige week hebben we deze oefening gemaakt, maar toen stonden alle tabbladen in een werkmap) (de sub van jou heb ik hierboven al in een bericht meegepakt)
Hieronder de 2 bestanden,

Bekijk bijlage InkoopBoek2017.xlsmBekijk bijlage StockBeheer2017.xlsm

Als er iets niet duidelijk is, vraag het op voorhand he, geen onnodig werk doen.

harry, kan de macro op voorhand kijken of de data al aanwezig is in tabblad "stockbeheer", (dit kan op kolomB"artikelnummer", dit zijn altijd unieke nummers) en als de data al aanwezig is, een scherm te krijgen met de tekst "data al gekopieerd", zo weet ik dat er geen dubbele data in de lijst stockbeheer is.
verder in de lijst stockbeheer, als de kolom "stock" 0 of leeg is, zou deze automatisch moeten verborgen worden.
de data dat gekopieerd wordt moet ook (plakken speciaal koppeling) zijn, zodoende als de data aanpast in "inkoopboek2017" bv tabblad 0201217A wordt, automatisch aanpast in "Stockbeheer" tabblad stockbeheer

Ik hoop dat alles duidelijk is, is steeds niet makkelijk om het neer te schrijven, maar doe mijn best :)

groetjes

Tom

Bekijk bijlage InkoopBoek2017.xlsmBekijk bijlage StockBeheer2017.xlsm
 
Maak de rijen zichtbaar zodat ze aaneengesloten zijn; deze code kan niet omgaan over meerdere selecties als je paste ,true wilt doen met formules.
Normaal doen we zoiets met de autofilter en direct wegschrijven, maar met die lege rijen werkt dat ook niet.

In tabblad 21032016A heb je een paar lege rijen die verborgen zijn; gewoon zichtbaar maken.
De lege rijen in stockbeheer worden weer verwijderd door de code.
Controleren of het al aanwezig is zit hier niet bij inbegrepen.

Code: 
Sub hsv()
Dim sh As Worksheet, c As Range
Application.ScreenUpdating = False
With GetObject(ThisWorkbook.Path & "\StockBeheer2017.xlsm")
.Windows(1).Activate
  With .Sheets("stockbeheer")
    For Each sh In ThisWorkbook.Sheets
        If Len(sh.Name) = 9 Then
           If sh.Range("B22") <> "" Then
                sh.Range("A22:U" & Application.Max(22, sh.Cells(125, 4).End(xlUp).Row)).Copy
                Application.Goto .Cells(Application.Max(14, .Cells(Rows.Count, 2).End(xlUp).Offset(1).Row), 2)
                .Cells(Application.Max(14, .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row), 1).PasteSpecial -4122
                .Paste , True
                .Cells(Application.Max(14, .Cells(Rows.Count, 23).End(xlUp).Offset(1).Row), 23).Resize(.Cells(Rows.Count, 2).End(xlUp).Row - Application.Max(14, .Cells(Rows.Count, 23).End(xlUp).Row)) = sh.Cells(4, 19).Value
                Application.CutCopyMode = 0
           End If
       End If
     Next sh
     On Error Resume Next
    .Columns(2).SpecialCells(4).EntireRow.Delete
  End With
End With
End Sub
 
harry,

net even getest, macro geeft volgende foutmelding
foutmeldingexport.JPG

Ik heb zoals je gevraagd heb op tabblad21032016A, alle rijen zichtbaar gemaakt

Als ik nu de macro laat uitvoeren, vind hij de juiste werkmap stockbeheer2017 en tabblad stockbeheer, maar hij kopieert veel meer als tabblad 21032016A
In de lijst staan alle data van 02-01-2017 tot 10-05-2016 ? (ik was gisteren de data aan het overkopieren en vandaag heb ik verder gedaan en zit al in de maand november, daardoor zijn er veel meer tabbladen bijgekomen, weliswaar allemaal met 9 karakters bv 04082016B

Heb je macro bij jou thuis geprobeerd in die 2 bestanden, krijg je dan ook die foutmelding ?

Tom
 
Tom,

Zorg ervoor dat je helemaal geen lege rijen hebt, dan hoef ik ook niet overal omheen breien om het werkend te krijgen.

Zelfs deze coderegel werkt al niet omdat het nu verwijzingen zijn geworden.
Code: 
 .Columns(2).SpecialCells(4).EntireRow.Delete

Dan maar iets anders
Code: 
Sub hsv()
Dim sh As Worksheet, c As Range
Application.ScreenUpdating = False
With GetObject(ThisWorkbook.Path & "\StockBeheer2017.xlsm")
.Windows(1).Activate
  With .Sheets("stockbeheer")
    For Each sh In ThisWorkbook.Sheets
        If Len(sh.Name) = 9 Then
                sh.Range("A22:U" & Application.Max(22, sh.Cells(125, 4).End(xlUp).Row)).Copy
                Application.Goto .Cells(Application.Max(14, .Cells(Rows.Count, 2).End(xlUp).Offset(1).Row), 2)
                .Cells(Application.Max(14, .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row), 1).PasteSpecial -4122
                .Paste , True
                .Cells(Application.Max(14, .Cells(Rows.Count, 23).End(xlUp).Offset(1).Row), 23).Resize(.Cells(Rows.Count, 2).End(xlUp).Row - Application.Max(14, .Cells(Rows.Count, 23).End(xlUp).Row)) = sh.Cells(4, 19).Value
                Application.CutCopyMode = 0
       End If
     Next sh
     For Each cl In .Columns(2).SpecialCells(-4123)
      If cl.Value = 0 Then
         If c Is Nothing Then Set c = cl Else Set c = Union(c, cl)
      End If
     Next cl
    If Not c Is Nothing Then c.EntireRow.Delete
  End With
End With
End Sub
 
Harry,

Even terug de tijd in :)

In bijlage een perfect werkende macro, zelfs wanneer lege rijen zichtbaar zijn, (in feite is hier met het huidig bestand niks veranderd)

Wat is er veranderd tov het ingevoegde bestand:

Nu moet de export gebeuren naar andere werkmap"stockbeheer2017" op tabblad "stockbeheer"
En in de inkoopboek, heb je niet enkel tabbladen met 9 karakters (bv 18032016a) maar heb je ook tabbladen bv beginjanuari 2017 (maar van deze tabbladen moet nooit niks gekopieerd worden)

Ik ga eerlijk zijn, ik kan niet echt meer volgen, maar ik denk dat je deze macro kunt hergebruiken, (qua dataexport) en dat je enkel een stukje moet bijprogrammeren om de locatie te veranderen (naar Stockbeheer.xlsm)

of zie ik dit verkeerd ?

ben hier zelf ook aan zoeken en proberen

Tom
 
Zet de blauwe regel er maar eens tussen en zie dat alleen de bladnamen met 9 karakters gekopieerd worden.

Code: 
If Len(sh.Name) = 9 Then
[COLOR=#0000ff]  msgbox sh.name[/COLOR]
 sh.Range("A22:U" & Application.Max(22, sh.Cells(125, 4).End(xlUp).Row)).Copy
 
Harry,

gedaan en klopt, maar zoals ik al zei, hij neemt de bladen maar tot 10 mei 2016 (dus tussen 10 mei en eind 2016, worden de bladen niet teruggevonden)

ik ben teruggevallen op de vroeger macro, en heb deze geplaatst in inkoopboek2017 (zie bijlage), deze werkt perfect

ik zal dan stockbeheer in de map"inkoopboek2017" laten staan (ik wou een andere map, omdat da makkelijker was voor onze consulenten, maar zal nu altijd een manueel handeling uitvoeren .... maar dat is niet erg hoor)
Wat wel leuk zo zijn, is dat er nagekeken wordt of dat data al aanwezig is .... en de velden die leeg of 0 aangeven bij stock (kolomH) automatisch verborgen worden

in bijlage voorbeeld uptodate (lukt niet meer is al meer als 4MB)

tom
 
Bij mij worden de bladen van 02122017A t/m 14032017C gekopieerd.

Dat zijn alle bladen met de 9 karakters en ik zie geen problemen.

Ik heb in de rijen 14 t/m 603 gekopieerde gegevens staan.
Jij mag ze tellen vanuit alle bladen.
Als het niet goed is zal ik er misschien nog eens induiken anders laat ik het er bij..
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan