Macro tussen 2 bestanden

[Excelamateur1]

Hallo,

Ik heb jullie hulp nodig!
Ik ben op zoek naar een macro die gegevens van het ene naar het andere bestand over zet, maar wel met bepaalde voorwaarden. Ik heb "Testbestand1" en "Testbestand2" toegevoegd als voorbeeld.

Wat ik wil dat de macro gaat doen is het volgende:
In "Testbestand2" staan 3 afdelingen. Als er bij een afdeling (maakt niet uit welke) een "WI" wordt toegevoegd, dan moeten de gegevens in "Testbestand1" worden ingevuld. (Ik heb er als voorbeeld twee handmatig ingevuld.)
Er mogen in "Testbestand1" geen lege kolommen voorkomen, dus hij moet de eerstvolgende lege kolom pakken.

(Het zou helemaal mooi zijn als hij alles wat wordt toegevoegd in "Testbestand1" per afdeling bij elkaar zet, maar als dat niet kan is dat ook niet erg. Mocht dit wel kunnen hoor ik dat ook heel graag)

Ik hoop dat jullie mij hierbij kunnen helpen en ik hoor ook graag wanneer het echt niet mogelijk is

 

[edmoor]

Op zich is dat geen probleem, maar om welke reden wil je dat in 2 bestanden hebben?

 

[Excelamateur1]

Op zich is dat geen probleem, maar om welke reden wil je dat in 2 bestanden hebben?

De reden dat ik het in 2 bestanden wil hebben is omdat er bij beide bestanden verschillende afdelingen werken. Ik heb dus niet de optie om het in 1 bestand te hebben. 1 afdeling moet het dus toevoegen in testbestand 2, zodat de andere afdeling dit in testbestand 1 ziet.

 

[maartenvers]

Moet de data dan live actualiseren na een wijziging?

Je kunt beide afdelingen ook via de cloud laten werken. Met Office365 kunnen er nl meerder mensen tegelijk in een bestand werken.

 

[Excelamateur1]

Moet de data dan live actualiseren na een wijziging?

Je kunt beide afdelingen ook via de cloud laten werken. Met Office365 kunnen er nl meerder mensen tegelijk in een bestand werken.

Ja live zou het beste zijn, maar het mag ook met een soort "refresh knop".

Via de cloud mag niet in het bedrijf. Ik heb het echt op deze manier nodig

 

[HSV]

In Thisworkbook-module van testbestand2.
Beide bestanden moeten in dezelfde map staan.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Columns(1), Target) Is Nothing Then
 If Target = "WI" Then
  With GetObject(ThisWorkbook.Path & "\Testbestand1.xlsm").Sheets(1)
    .Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Resize(3) = Application.Transpose(Array(Target.Offset(, 1), Target.Offset(, 2), Split(Sh.Name)(1)))
    .Range("c1", .Cells(3, Columns.Count).End(xlToLeft)).Sort .Cells(3, 3), Header:=xlNo, Orientation:=xlSortRows
    .Parent.Windows(1).Visible = True
    .Parent.Close True
  End With
 End If
End If
End Sub

 

[Excelamateur1]

In Thisworkbook-module van testbestand2.
Beide bestanden moeten in dezelfde map staan.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Columns(1), Target) Is Nothing Then
 If Target = "WI" Then
  With GetObject(ThisWorkbook.Path & "\Testbestand1.xlsm").Sheets(1)
    .Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Resize(3) = Application.Transpose(Array(Target.Offset(, 1), Target.Offset(, 2), Split(Sh.Name)(1)))
    .Range("c1", .Cells(3, Columns.Count).End(xlToLeft)).Sort .Cells(3, 3), Header:=xlNo, Orientation:=xlSortRows
    .Parent.Windows(1).Visible = True
    .Parent.Close True
  End With
 End If
End If
End Sub

Bedankt voor je reactie Harry, maar de onderstaande regel geeft een foutmelding.

 

[HSV]

Staat er een spatie tussen je bladnamen?
Voeg onderstaande coderegel er eens boven.

Msgbox Split(sh.name)(1)

En geef het resultaat ervan hier eens weer.

 

[Excelamateur1]

Staat er een spatie tussen je bladnamen?
Voeg onderstaande coderegel er eens boven.

Msgbox Split(sh.name)(1)

En geef het resultaat ervan hier eens weer.

In testbestand 1 niet, in 2 wel.

Dit is het resultaat wat ik krijg:

 

[HSV]

Geen idee, kan niet eerder testen dan vanavond.
Je kan .Sheets(1) eens proberen te veranderen in .Blad1

 

[Excelamateur1]

Geen idee, kan niet eerder testen dan vanavond.
Je kan .Sheets(1) eens proberen te veranderen in .Blad1

Helaas werkt dit ook niet.

Geen probleem, ik zie je antwoord graag tegemoet!

 

[HSV]

Ik heb nog één suggestie tot nu, sluit het bestand "testbestand1" en draai de macro dan eens.

 

[Excelamateur1]

Ik heb nog één suggestie tot nu, sluit het bestand "testbestand1" en draai de macro dan eens.

Helaas krijg ik dan alsnog een foutmelding in dezelfde regel.

 

[HSV]

Het loopt hier vlekkeloos.
Twee suggesties:
Verander Sheets(1) in Sheets("Blad1")
of/en

= Application.Transpose(Array(Target.Offset(, 1), Target.Offset(, 2), Split(Sh.Name)(1)))

in.

= Application.Transpose(Array(Target.Offset(, 1).Value, Target.Offset(, 2).Value, Split(Sh.Name)(1)))

 

[Excelamateur1]

Het loopt hier vlekkeloos.
Twee suggesties:
Verander Sheets(1) in Sheets("Blad1")
of/en

= Application.Transpose(Array(Target.Offset(, 1), Target.Offset(, 2), Split(Sh.Name)(1)))

in.

= Application.Transpose(Array(Target.Offset(, 1).Value, Target.Offset(, 2).Value, Split(Sh.Name)(1)))

Hij werkt! Het enige probleem dat ik nu heb is dat wanneer ik versienummer 3 in vul, hij in het andere bestand versie 2 in vult

 

[HSV]

In welk kolom staat de 1, 2 of 3?
Graag de reageerknop gebruiken; citeren is niet nodig.

 

[Excelamateur1]

In de 4e kolom.

 

[HSV]

Wijzig split(sh.name)(1) in target.offset(,3).text

Of

=application.transpose(target.offset(,1).resize(,3).text)

 

[Excelamateur1]

Dit werkt, dankjewel!

Is er ook een mogelijkheid dat wanneer een versienummer wordt aangepast dat hij dat ook aanpast in het andere document?

 

[HSV]

Dat kan, maar ik zie zo geen unieke combinatie om de juiste regel op te zoeken en aan te passen.
Een combinatie van documentnaam; documentnummer en versienummer zullen vast vaker voor komen dan een keer denk ik zo.