Cellen kopieren van verschillende tabbladen naar 1 tabblad

Status
Niet open voor verdere reacties.

tombeerke

Gebruiker
Lid geworden
8 jan 2017
Berichten
280
heren,

Ik weet niet hoe ik eraan moet beginnen, daarom heb ik een voorbeeldbestand ingevoegd, om toch een klein beetje duidelijkheid te krijgen in mijn vraag.
Ik heb zelf geprobeerd met macro opnemen, maar daar kom ik niet ver mee
En via het forum heb ik zoveel verschillende sub gezien, dat ik het bos door de bomen niemeer zie ....
Wie kan me op weg helpen

bedankt alvast,

Kijk even naar mijn voorbeeldbestandBekijk bijlage TestInkoopBoekKopierenCellenNaarStockbeheer.xlsm

groetjes

Tom
 
Begin met een gestructureerde data-opzet. In het bestand dat je nu hebt is alleen het bos te vinden zonder een boom te zien.
 
Code:
Sub hsv()
Dim sh As Worksheet, frm As Range
Application.ScreenUpdating = False
Set sh = Sheets("stock")
With ActiveSheet.Range("B21").CurrentRegion.Resize(, 21)
.AutoFilter 2, "<>0"
     sh.UsedRange.ClearContents
.Copy
     sh.Paste , True
     sh.Columns.AutoFit
     Application.Union(sh.Columns(1), sh.Columns(3), sh.Columns(5), sh.Columns(7), sh.Columns(9), _
     sh.Columns(11).Resize(, 2), sh.Columns(14), sh.Columns(16), sh.Columns(18), sh.Columns(20)).Delete
 .AutoFilter
End With
End Sub
 
Beste harry,

macro loopt vast, krijg volgende foutmelding

hsv.JPG

bedankt alvast

tom
 
De macro niet starten vanaf Stock.

Kan het wel aanpassen, maar probeer het eerst maar eens zo.
 
gelijk welk tabblad als ik zeg, macro hsv uitvoeren, krijg ik foutmelding
wel raar dat hij zegt, foutmelding autofilter, omdat er in bestand geen autofilter zit, of zie ik dit verkeerd :)
 
Hier werkt het goed.
Met de code zet ik er een autofilter op en er weer af.
In de tussentijd kopieert het de gegevens.

Test de bijlage eens.
 

Bijlagen

  • TestInkoopBoekKopierenCellenNaarStockbeheer2.xlsb
    137,7 KB · Weergaven: 39
harry,

getest, tabblad 1 werkt het en geeft copy op tabblad stock
als ik hetzelfde doe van tabblad 2, krijg ik terug dezelfde foutmelding

ook de cel s6 wordt niet mee gekopieerd
 
Harry,

bedoeling is ook dat de data van tabblad 2, onder de data van tabblad 1 komt, in het tabblad "stock"
als ik nog wat verder testte, kwam ik er ook op uit dat de titels mee werden gekopieerd, dus in feite 2 rijen te veel, als ik de range in je sub van range21 naar 23 veranderde, was dat oke, echter was de layout dan opeens ook anders :)

het is toch nie simpel hoor, vba, ik probeer de subs te ontleden, dat ik hieruit leer, maar is niet zo evident he :)

groetjes

Tom
 
Er staat al een autofilter op rij 18, maar die zie je niet.
Test dit maar eens.
Code:
Sub hsv()
Dim sh As Worksheet
Application.ScreenUpdating = False
Set sh = Sheets("stock")
[COLOR=#0000ff]With ActiveSheet.Range("A21:U123")[/COLOR]
[COLOR=#0000ff]If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False[/COLOR]
.AutoFilter 2, "<>0"
     sh.UsedRange.ClearContents
.Copy
     sh.Paste , True
     sh.Columns.AutoFit
     Application.Union(sh.Columns(1), sh.Columns(3), sh.Columns(5), sh.Columns(7), sh.Columns(9), _
     sh.Columns(11).Resize(, 2), sh.Columns(14), sh.Columns(16), sh.Columns(18), sh.Columns(20)).Delete
 .AutoFilter
End With
End Sub
Kijk morgen wel even verder wat de bedoelingen zijn.
 
Harry,

van de autofilter op rij 18 had ik weet, via die filter heb ik de macro gemaakt rijen invoegen, rijen verwijderen.

heb de laatse versie getest, op beide tabs, en werkt perfect.
Enkel op tabblad STOCK komt de data NIET onder elkaar, telkens bij de laatste "copy" van een tabblad, zou deze moeten aanvullen op de eerste vrije regel van tabblad "stock"

groetjes

Tom
 
Beter?
Code:
Sub hsv()
Dim sh As Worksheet
Application.ScreenUpdating = False
Set sh = Sheets("stock")
If Not ActiveSheet.Name = "STOCK" Then
 With ActiveSheet.Range("A21:U123")
  If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
     .AutoFilter 2, "<>0"
       Application.Union(.Columns(1), .Columns(3), .Columns(5), .Columns(7), .Columns(9), _
       .Columns(11).Resize(, 2), .Columns(14), .Columns(16), .Columns(18), .Columns(20)).Copy
       Application.Goto sh.Cells(IIf(IsEmpty(sh.Range("a1")), 1, sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row), 1)
       sh.Paste , True
    .AutoFilter
End With
End If
End Sub
 
Beste Harry,

Ik ben aan knoeien geweest met je macro maar krijg het niet echt goed,
Ik heb dan maar een bestandje meegestuurd, waar ik alles heb proberen uitleggen, met toeters en bellen, hopelijk begrijp je mijn scenario
Ik heb bewust de macro uit het bestand weggelaten, ik zou graag hebben dat je het vooraleerst eens bekijk, en hoop dat je hierdoor meer inzicht krijg op het geen ik graag zo willen ....

bekijk het eens en laat je iets weten,

thx

Tom

Bekijk bijlage TestStockbeheer.xlsm
 
Nu moet het weer anders worden?

Eerst moesten een bepaald aantal kolommen niet meegenomen worden
De gegevens moesten bijgewerkt worden als je in de tabbladen iets veranderde.
Dit alles zie ik niet terug in jouw bestand.
Ook is de naam van het blad veranderd

Voor mij is het appeltje eitje, maar als we steeds veranderen van koers ben ik er wel klaar mee.
Dat moment is nu wel gekomen.

Succes.

Overigens: In je andere vraag staan meer suggesties dan alleen van @edmoor.
Daar vind je het antwoord ook tussen.
 
Harry,

Wat is dit nu opeens ?
het klopt dat ik een verandering heb doorgevoerd, omdat ik samen met mijn vrouw ff de sheet van stockbeheer had doorgenomen, daarom had ik het nieuwe bestand meegestuurd.

De koppeling die gekopieerd dient te worden moet inderdaad plakken speciaal zijn, zodoende de tekst of getallen automatisch mee veranderen in "stockbeheer"

Kan je me aub verder helpen

Wat betreft, @edmoor, op die vraag had ik de laatste reactie enkel gezien, en die geprobeerd, ik wilde je daar niet mee kwetsen hoor, sorry alvast daarvoor

kan je me aub verder helpen, met mijn vraag
Sorry

Tom
 
Als dit beter is, doe je vrouw de groeten van me. :rolleyes:

Code:
Sub hsv()
If ActiveSheet.Name <> "Stockbeheer" Then
 If Range("B22") <> "" Then
   Range("B22:U" & Application.Max(22, Cells(124, 2).End(xlUp).Row)).Copy
    With Sheets("stockbeheer")
        Application.Goto .Cells(Rows.Count, 2).End(xlUp).Offset(1)
       .Paste , True
    End With
   Application.CutCopyMode = 0
 End If
End If
End Sub
 
harry,

een echtscheiding vermeden hier :p:p .... thx voor je hulp
heb de sub ff geprobeerd, en werkt, alleen komen de kolommen niet echt direct uit, maar ga ff zelf proberen aan te sleutelen

Vraagje: heb je rekening gehouden met cel S6, factuurdatum om mee te kopieren ?

je hoor nog van me

Je blijft een KRAK :thumb:

Tom
 
Harry,

Ik bots al op een eerste issue, als ik de lege rijen wegdoe, dus enkel de ingevulde rijen tussen B22:B123 blijven zichtbaar, als ik dan exporteer, neem hij enkel de eerste lijn mee naar STOCKBEHEER

Ik probeer een uitleg te geven, een inkooporder heeft nooit meer als 100 artikelen, als alles is ingeboekt, doen we lege rijen verwijderen, en willen we dan via een macro de data overzetten naar STOCKBEHEER.

Zoals ik in vorige reactie zei, ben ik aan uitvissen waarom sommige cellen, niet op de juiste plaats komen, zal er een voorbeeldbestandje van maken

thx harry :thumb:

tom
 
Beste Harry,

Ik even nagekeken, en proberen aanduiden op tabblad stockbeheer, hetgeen ergens misloopt.
Kan het zijn omdat we formules in bepaalde cellen doorkopieren ?
is toch complexer als gedacht, maar blijft een uitdaging, alleen zonder je hulp kom ik nergens, ik probeer van elke sub dat je aanlevert, te ontleden en bij te leren, maar is niet simpel hoor :shocked::shocked::shocked:

Zal het bestandje mee uploaden, dan kan je ff bekijken

groetjes

Tom

Bekijk bijlage TestStockbeheer.xlsm
 
Tom,

Alweer een verandering?
Nu kolom A er ook nog maar bij?

Als je de opmaak van de cellen goed had staan zag je dat de gegevens er wel stonden.

Ik wil best helpen, maar ik werk niet voor de prullenbak.

Code:
Sub hsv()
If ActiveSheet.Name <> "Stockbeheer" Then
 If Range("B22") <> "" Then
    Application.ScreenUpdating = False
    Set sh = ActiveSheet
     Range("A22:U" & Application.Max(22, Cells(124, 2).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(6, 19).Value
          End With
        Application.CutCopyMode = 0
  End If
End If
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan