Een aantal cellen (7 stuks) van de ene werkmap naar andere werkmap brengen

Status
Niet open voor verdere reacties.
T

tombeerke

Gebruiker
Lid geworden
8 jan 2017
Berichten
280
Heren,

in bijlage heb ik 2 bestanden geupload, enerzijds werkmap "calculatiemap", met tabblad"Commissiegastvrouwen", in deze werkmap zou ik graag 7 cellen verkrijgen op een welbepaalde plaats (ZieBijlages), steeds ingevuld in de eerste vrije rij.
Anderzijds heb ik de werkmap"InputConsulente", met tablad"21032017Olivia De Boeck" (als voorbeeld), van hieruit zo ik dus graag een macro laten lopen dat de cellen dan op de juiste plaats in de werkmap"calculatiemap" zet.
Ik heb uit beide bestanden veel data gehaald, dat hier toch niet van toepassing was ...

Wie kan dit eens bekijken, en weet een oplossing hiervoor ?

Alvast bedankt

Tom

Bekijk bijlage CalculatieMap.xlsmBekijk bijlage InputConsulente.xlsm
 
Geen idee hoe ervaren je met VBA bent maar als ik het goed begrijp moet de structuur van je code als volgt zijn (laat maar weten als je meer concrete code nodig hebt)

1. Openen van een andere werkmap
Code: 
With Application.FileDialog(msoFileDialogOpen)
    .Show
    .Spath =.SelectedItems(1)

End With

Application.Workbooks.Open (sPath)

sFile =ActiveWorkbook.Name

2. Waarde van werkmap 2 overzetten naar werkmap 1

Code: 
 Workbooks("Naam").worksheets("X").Range("XX:XX").Value = _ 
    Workbooks.Sfile).worksheets(....

'LET OP: De range is dus afhankelijk van de eerste lege rij deze moet je eerst nog definieren

3. Sluiten van de werkmap
Code: 
 Application.Workbooks(sFile).Close


Hoop dat je zo gehol
 
Als beide bestanden in dezelfde map zitten.
Code: 
Sub hsv()
Set wb = ThisWorkbook.Sheets("21032017Olivia De Boeck")
With Workbooks.Open(ThisWorkbook.Path & "\CalculatieMap.xlsx")
   With .Sheets("Commissiegastvrouwen")
    .Cells(Application.Max(9, .Cells(Rows.Count, 4).End(xlUp).Row), 4).offset(1).Resize(, 9) = Array(wb.[B3], .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 5), wb.[B6], wb.[J2], wb.[J4], .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 9), wb.[J6], wb.[F2], wb.[F4])
   End With
 .Close -1
End With
End Sub
 
Harry,

ben even niet mee, of begrijp niet goed wat je bedoeld met als beide bestanden in dezelfde map zitten
Als ik je sub probeer te ontleden, begrijp ik (vermoed ik) thisworkbook.sheets("2103.........") is een werkblad in de werkmap "inputconsulente"
De regel daaronder begrijp ik (Workbooks.open ...... "calculatiemap.xlsx" dat verwijst dus naar een blad in een andere werkmap "calculatiemap" (maar die map heeft ook .xlsm

Ik heb wel al het tabblad gekopieerd "commissiegastvrouwen" naar de werkmap "inputconsulente", maar ook dan gaat de macro niet werken.

kan je me op weg helpen aub

Tom
 
Harry,

Nog even ter verduidelijking, zo dat we mekaar goed begrijpen, en geen onnodig werken doen.
Werkmap CalculatieMap (deze werkmap heeft vele tabbladen, een heeft de vaste naam en zal NOOIT veranderen, genaamd, tabblad"CommissieGastvrouwen"

De andere werkmap "InputConsulente" heeft wekelijks nieuwe tabbladen met steeds andere tabbladnamen, de tabbladnaam is steeds samengesteld uit datum + naam consulente, vb 21032017Olivia De Boeck

Wat wil ik nu graag bekomen, dat uit de werkmap InputConsulente, van elk tabblad afzonderlijk, een macro de opdracht geeft om de volgende cellen (dit zijn wel steeds DEZELFDE), B3 - B6 -F2 - F4 - F6 - J2 - J4 - J6, kopieert naar de werkmap CalculatieMap op Tabblad"Commissiegastvrouwen" steeds op de eerst vrije rij.

beide bestanden staan altijd open op mijn pc

Is het nu wat duidelijker Harry ?

Anders vraag gerust he,

groetjes

Tom
 
Dat deed de code al Tom.
Op alle tabbladen na dan.

Stop beide bestanden in dezelfde map of van mijn part op je desktop.
Open alleen bestand "inputconsulente".
Stop de code in een module, en laat de code lopen.
Het bestand (als dat een .xlsm is verander je dat even in de code) wordt op de achtergrond geopend en weer gesloten.
Even handmatig openen om het resultaat te bekijken.

Als je nu wel gegevens krijgt, zal ik de code aanpassen; test dit maar eerst eens.
 
harry,

net getest, code aangepast naar xlsm, en werkt prima, idd hij open de andere map, plaats op de juiste plaats alle inhoud, en sluit terug, FANTASTISCH

Alleen het formaat van de datum wordt niet correct weergegeven, geeft nu 42815, als ik de celeigenschappen aanpas naar datum, kom hij wel in 21-03-2017, kan dit automatisch of moet ik die celeigenschappen op voorhand aanpassen, idem voor de waarde, daar ontbreekt € teken.

Als je nu kan regelen, dat dit vanuit alle verschillende tabbladen van de map "inputconsulente" kan gebeuren, is er weer een stap opgelost.

groetjes,

Tom
 
Welke bladen niet!
 
Harry,
Als ik eenmaal de celeigenschappen heb aangepast in calculatiemap blijven deze behouden, dus daar moet je geen rekening meer met houden.

Kan er ook aangepast worden, dat de macro de map niet gaat openen, omdat alle mappen steeds opstaan (of toch bijna altijd), en enkel de map gaat open indien nodig (ze mag dan blijven openstaan na de copy)

thx

Tom
 
Harry,

Op je vraag welke bladen NIET !

De map is opgemaakt, zoals je reeds bekend, dus van BASISXLT, InkoopstartQ1, Startjanuari2017, EindJanuari2017, en zoals je weet komen telkens daartussen invoegbladen, ik zou dus van al die ingevoegde bladen, de cellen kunnen overplaatsen,

Snappie ?
 
Harry,

Ik denk als je in je formule opneem <> van "basisxlt" dat het oke is, van de bladen met StartJanuari Eindjanuari enz wordt toch niks overgezet !
 
Code: 
Sub hsv()
With GetObject(ThisWorkbook.Path & "\CalculatieMap.xlsx")
 .Windows(1).Activate
  For Each sh In ThisWorkbook.Sheets
   If sh.Name <> "BASISXLT" Then
    With .Sheets("Commissiegastvrouwen")
     .Cells(Application.Max(9, .Cells(Rows.Count, 4).End(xlUp).Row), 4).Offset(1).Resize(, 9) = Array(sh.[B3], .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 5), sh.[B6], sh.[J2], sh.[J4], .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 9), sh.[J6], sh.[F2], sh.[F4])
    End With
  End If
 Next sh
End With
End Sub
 
Laatst bewerkt:
Harry,

Werkt perfect, zowel als de map "calculatiemap" geopend of niet geopend is !

Hij kopieert ook de juiste cellen op de juiste rijen, alleen doet hij dat voor alle tabbladen gelijktijdig ! En daar wringt het schoentje

Ik leg uit:
Op 20032017 is er een consulente aan het werk, haar fiche wordt op 24032017 verwerkt (= er wordt een tabblad gecreeerd op 23032017, met alle data), het tabblad wordt afgewerkt, en op het einde wil ik dan de "benodigde" cellen doorkopieren naar "commissiegastvrouwen"

Stel nu: op 22032017 is er weer een homeparty, zelfde werkwijze als hierboven, maar als ik de data exporteer, gaat hij dus ook nog eens de data van 23032017 mee copieren,en krijg ik dus dubbele gelijke data in mijn tabblad 'commissiegastvrouwen"

dus dat zo nog moeten opgelost worden :)
 
Zijn er meerdere bladnamen die met dezelfde datum beginnen?
Bv. 21032017kees, 21032017piet.
 
De datum, dus de eerste 8 karakters, kunnen idd meer als eens voorkomen, wij hebben tal van consulentes, en het gebeurt dat er op dezelfde datum 2 of meerdere homeparty's plaatsvinden.
Na de 8 karakters zijn het wel altijd andere namen bv OliviaDeBoeck, nancyBulté, enz, enz

Duidelijk ?
Anders vraag maar he
 
Ik heb de code aangepast, alsook de bladnamen.
Tussen de datum en de naam staat een underscore om het werkend te krijgen.
Zo kan de code zoeken op datum en naam (gescheiden dus door de underscore).

Test het maar eens.
 

Bijlagen

  • InputConsulente.xlsb
    63,3 KB · Weergaven: 37
  • CalculatieMap.xlsx
    49,9 KB · Weergaven: 41
Laatst bewerkt:
Harry,

Ik heb uitvoerig getest, ik heb zelfs je macro overgeplaatst naar de definitieve mappen en bestanden, en alles werkt PERFECT ! :thumb::thumb::thumb:

Nog 2 kleine vragen:

Map "inkoopconsulente", als cel B9=Ja kan dan automatisch in de map"Calculatiemap" in kolom E "AK14" (dit is een intern rubrieknummer) op de rij dat gekopieerd wordt ?

Andere vraag:

ken je per toeval een formule die 21/03/2017 automatisch omzet naar 21032017_ (dan verminder ik het risico dat ik de underscore vergeet ;) )

Tom
 
Vraag 1:
staat twee keer in de code.
Code: 
 .Cells(Application.Max(8, .Cells(Rows.Count, 4).End(xlUp).Row), 4).Offset(1).Resize(, 9) = Array(sh.[B3], [COLOR=#0000ff]IIf(sh.[B9] = "JA", "AK14", .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 5))[/COLOR], sh.[B6], sh.[J2], sh.[J4], .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 9), sh.[J6], sh.[F2], sh.[F4])

vraag2:
Wat linksom kan, kan ook rechtsom.
Code: 
Sub hsv_2()
 ActiveSheet.Name = Replace(Format(Range("B3"), "dd-mm-yyyy"), "-", "") & "_" & Range("B6").Value
End Sub
 
Harry,

Wow wow wow,
Ik heb alles in de live omgeving geplaatst voor zowel commissiegastvrouwen en commisieconsulenten, alles overal netjes aangepast, alle macro's opnieuw toegevoegd, en alles werkt PERFECT

Dit is een hele stap vooruit !

Stap voor stap komen we in de buurt wat ik voor ogen had ..... :rolleyes::rolleyes::rolleyes:

nogmaals, thanks very much :thumb::thumb:

Tom

ps: ik ga je straks nog enkel vraagjes stellen op een ander topic
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan