Macro voor ophalen van data uit ander bestand

[hermes79]

Goede avond,

ik heb momenteel een Excel file met 4 tabbladen waarbij ik mbv macro's data ga ophalen uit 4 verschillende excel files, dewelke in één bestandsmap staan.

Ik heb een commando ingebouwd waardoor de 4 macro's na elkaar gaan lopen.
Beperking is echter dat hiervoor mijn bestanden dienen geopend te zijn en ik zou dit graag automatisch laten lopen als ik de file open

Onderstaand één van de 4 macro's, dewelke allemaal ongeveer gelijk zijn opgebouwd:

Sub macro1()
Workbooks("Bestellingen.xlsx").Sheets("Orders").Range("A2:H" & Range("A2").End(xlDown).Row).Copy Destination:= _
ThisWorkbook.Sheets("Orders19").Range("F2:M" & Range("F" & Rows.Count).End(xlUp).Row + 1)
End Sub

En momenteel zorgt deze macro ervoor dat de macro's na elkaar lopen.

Private Sub CommandButton1_Click()
Call Blad1.macro1
Call Blad2.macro2
Call Blad3.macro3
Call Blad4.macro4
End Sub

Maar verder geraak ik helaas niet.

Alvast bedankt

 

[VenA]

En ik ook niet. Kan je nog minder informatie geven voor een ogenschijnlijk simpel probleem?

Lees eerst dit maar eens.
https://www.helpmij.nl/forum/announcement.php?f=5

 

[hermes79]

Mijn excuses.

in bijlage kan je mijn bestand vinden.
Hopelijk maakt dit al wat meer duidelijk.

Er wordt data opgehaald uit 4 verschillende bestanden en deze worden in specifieke cellen in het doelbestand geplaatst.
Code werkt zoals ik het wil maar de beperking is dat de bronbestanden moeten geopend zijn.

 

[edmoor]

Een bestand waaruit je iets wilt lezen moet altijd open zijn, maar dat kan je ook vanuit je code doen en dan dat bestand ook weer sluiten als je de gewenste gegevens hebt opgehaald, zonder dat dit in beeld zichtbaar is.
Bijvoorbeeld d.m.v. Application.ScreenUpdating = False

 

[hermes79]

Dat het bestand dient open te zijn om iets uit te lezen begrijp ik.

En zoals jij aangeeft zou ik de bronbestanden willen openen en nadien sluiten vanuit mijn macro.
Helaas slaag ik er niet in dit te doen werken

Sub macro1()
wbnaam = "C:\MAP\SUBMAP\BESTAND 1.xlsx"
Workbooks(wbnaam).Open
Workbooks("BESTAND 1.xlsx").Sheets("GROEN").Range("A2:L" & Range("A2").End(xlDown).Row).Copy Destination:= _
ThisWorkbook.Sheets("GROEN").Range("B2:M" & Range("B" & Rows.Count).End(xlUp).Row + 1)
Workbooks(wbnaam).Close False
End Sub

 

[edmoor]

Wat ik al zei, als je huidige code al werkt, hoewel dat beter kan:

Sub macro1()
    [COLOR="#FF0000"]Application.ScreenUpdating = False[/COLOR]
    wbnaam = "C:\MAP\SUBMAP\BESTAND 1.xlsx"
    Workbooks(wbnaam).Open
    Workbooks("BESTAND 1.xlsx").Sheets("GROEN").Range("A2:L" & Range("A2").End(xlDown).Row).Copy Destination:= _
    ThisWorkbook.Sheets("GROEN").Range("B2:M" & Range("B" & Rows.Count).End(xlUp).Row + 1)
    Workbooks(wbnaam).Close False
    [COLOR="#FF0000"]Application.ScreenUpdating = True[/COLOR]
End Sub

 

[snb]

Gebruik geen workbooks.open maar Getobject()

 

[hermes79]

Ben geen helaas geen expert in VBA.

Wordt dit het dan?

Sub macro1()
Application.ScreenUpdating = False
wbnaam = "C:\MAP\SUBMAP\ BESTAND 1.xlsx"
GetObject ("C:\MAP\SUBMAP\ BESTAND 1.xlsx ")
Workbooks("BESTAND 1.xlsx").Sheets("GROEN").Range("A2:L" & Range("A2").End(xlDown).Row).Copy Destination:= _
ThisWorkbook.Sheets("GROEN").Range("B2:M" & Range("B" & Rows.Count).End(xlUp).Row + 1)
Workbooks(wbnaam).Close False
Application.ScreenUpdating = True
End Sub

 

[VenA]

Om het in 1 keer te doen

Sub VenA()
  c00 = "E:\Temp\bestand "
  ar = Split("GROEN BALUW GEEL ROOD")
  For j = 0 To 3
    With GetObject(c00 & j + 1 & ".xlsx")
      ar1 = .Sheets(ar(j)).Cells(2, 1).CurrentRegion
      .Close 0
    End With
    Sheets(ar(j)).Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(UBound(ar1), UBound(ar1, 2)) = ar1
  Next j
End Sub

 

[hermes79]

In één beweging zal dit niet kunnen vrees ik

Heb nogmaals het voorbeeld toegevoegd.
Volgende beperkingen:

• 
  Sheets in de bronbestanden hebben andere namen dan deze in het doelbestand
  Het aantal te kopiëren kolommen is verschillend van bronbestand tot bronbestand
  De data dient ingevuld te worden vanaf een specifieke bepaalde kolom in de sheets van het doelbestand

 

[VenA]

Steekt lekker logisch in elkaar dan.

Sub VenA()
  c00 = "C:\MAP\SUBMAP\"
  ar = Split("Belgium France Sweden Germany RED BLUE Yellow White Rood Blauw Geel Wit 12 8 11 14 2 4 6 2")
  For j = 0 To 3
    With GetObject(c00 & ar(j) & ".xlsx").Sheets(ar(j + 4))
     ar1 = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Resize(, ar(j + 12))
     .Parent.Close 0
    End With
    Sheets(ar(j + 8)).Cells(Rows.Count, Val(ar(j + 16))).End(xlUp).Offset(1).Resize(UBound(ar1), UBound(ar1, 2)) = ar1
  Next j
End Sub

 

[hermes79]

Beste,

de bronbestanden worden automatisch aangeleverd dus deze kan ik helaas niet beïnvloeden.

De macro werkt perfect op een allerlaatste punt na.
De data mag steeds weggeschreven worden vanaf rij 2, nu gaat hij op zoek naar de eerste lege rij.
Dat de data wordt overschreven telkenmale de macro loopt is geen punt.

 

[VenA]

Weer wat nieuws bedacht? Dan moet je het zelf maar even aanpassen. De initiële vraag lijkt mij beantwoord.

 

[hermes79]

VenA,

Mijn 4 oorspronkelijke, separate macro's deden dit wel.
En zoals ik reeds zei, ik ben geen VBA expert, mijn excuses!

 

[VenA]

Dat denk ik niet. Maar goed een leeg voorbeeldbestand geen voorbeeld van 1 van de bron bestanden tja.

uit jouw eigen code:

ThisWorkbook.Sheets("GROEN").Range("B2:M" & Range("B" & Rows.Count).End(xlUp).Row + 1)

Dit impliceert dat er regels toegevoegd moeten worden en niet dat de oude data vervangen moet worden door nieuwe. En kan dus niet gewerkt hebben.

 

[hermes79]

OK wederom gelijk.

Ik open alvast een andere thread om de laatste sleutel tot mijn oplossing te vinden.

Groeten,

Hermes

 

[VenA]

Is toch alleen een kwestie van het bereik leegmaken en dan de nieuwe waarden er neerzetten?

 

[hermes79]

Klopt maar mijn kennis van VBA is beperkt tot het knippen en plakken van stukken codes die ik links en rechts vind.

Dus voor mij is dit niet zo voor de hand liggend

 

[hermes79]

VenA,

heb zelf een ClearContents toegevoegd en werkt nu zoals ik het wil.

Topic mag gesloten worden

 

[emields]

@hermes79

dat kan je zelf doen in uw eerste post.