Macro: Overzichtsfile bijhouden uit verschillende files

[Phyxsius]

Hallo,

Allereerst even vermelden dat vandaag mijn eerste ervaring in de "macrowereld" is

Volgende procedure zou ik graag in een macro gieten:
Gegevens:
1 excel bestand met een algemeen overzicht, genaamd "Overview.xls"
x aantal excel bestanden, met willekeurige bestandsnamen

De macro moet opgeslagen worden in "Overview.xls"

Wanneer de macro geopend wordt in "Overview.xls", moet hij eerst vragen welk bestand geopend moet worden.
Eens dit bestand geopend, moet de macro een aantal velden uit dit bestand kopiëren naar "Overview.xls".

Deze laatste stap is niet zo moeilijk, maar ik weet echter niet hoe ik moet implementeren dat het "bronbestand" willekeurig kan zijn, en eerst gekozen moet worden.

Kan iemand me hiermee helpen aub ?

Alvast bedankt !

Ilja

 

[Wigi]

Ilja

gebruik bijv.

Sub GetFile()
Dim Filt As String
Dim FilterIndex As Integer
Dim Title As String
Dim FileName As String

Filt = "Excel Files (*.xls),*.xls"
Title = "Selecteer het bestand dat je wil openen."
FileName = Application.GetOpenFilename(FileFilter:=Filt, FilterIndex:=FilterIndex, Title:=Title)
If FileName = "" Then
    MsgBox "No file was selected."
    Exit Sub
End If
MsgBox "You selected " & FileName
Workbooks.Open FileName
End Sub

Wigi

 

[Phyxsius]

Hartelijk dank Wigi.

Nu rest me enkel nog de vraag:
Hoe maak ik de macro duidelijk dat hij bv. veld A1 van het geopende bestand moet kopiëren naar "Overview.xls" ?
Maw met welke code kan ik de bestandsnaam als variabele gebruiken in:

Windows("yyy.xls").Activate
Range("A1").Select
Selection.Copy
Windows("Overview.xls").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select

Ik heb geprobeerd om ipv "yyy.xls" gewoon FileName te gebruiken, maar dan krijg ik een error...

Alvast bedankt !

 

[Wigi]

Voila, hier is de oplossing

Sub ImportGood()
    Dim wbResult As Workbook, wbSource As Workbook, CopyRng As Range, Dest As Range
    Dim FileName As String, Filt As String
    
    Set wbResult = ThisWorkbook
    Set Dest = wbResult.Sheets("Blad1").Range("A1")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
      
    Filt = "Excel Files (*.xls),*.xls"
    FileName = Application.GetOpenFilename(Filt)
    
    Set wbSource = Workbooks.Open(FileName)
    Set CopyRng = wbSource.Sheets("Blad1").Range("A5")
    Dest = CopyRng
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    wbSource.Close
    wbResult.Activate
    MsgBox "Kopiëren is gebeurd."
End Sub

Pas de bladnamen en ranges aan.

Wigi

 

[Phyxsius]

Hartelijk dank Wigi, dit is net wat ik moest hebben !

 

[Phyxsius]

Ik heb de range van de te kopiëren cel aangepast naar "K12:Y13", vermits dit een "gemergede" cel is, maar hij kopieert de inhoud niet. Hij geeft enkel de melding "Kopiëren is gebeurd".
Om zo'n cel aan te geven, moet je toch gewoon als code Range("K12:Y13") ingeven, of niet ??

Alvast bedankt.

Sub ImportGood()
    Dim wbResult As Workbook, wbSource As Workbook, CopyRng As Range, Dest As Range
    Dim FileName As String, Filt As String
    
    Set wbResult = ThisWorkbook
    Set Dest = wbResult.Sheets("Blad1").Range("A1")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
      
    Filt = "Excel Files (*.xls),*.xls"
    FileName = Application.GetOpenFilename(Filt)
    
    Set wbSource = Workbooks.Open(FileName)
    Set CopyRng = wbSource.Sheets("Blad1").Range("[COLOR="Red"][B]K12:Y13[/B][/COLOR]")
    Dest = CopyRng
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    wbSource.Close
    wbResult.Activate
    MsgBox "Kopiëren is gebeurd."
End Sub

 

[Wigi]

Gouden regel: vermijd te werken met merged cells...

Indien toch, bedoel je dat je een bereik van 15 kolommen en 2 rijen in 1 cel "merget"?

Probeer eens

Set CopyRng = wbSource.Sheets("Blad1").Range("K12:Y13").Range("A1")

ofwel

Set CopyRng = wbSource.Sheets("Blad1").Range("K12")

Wigi

 

[Phyxsius]

Dankuwel Wigi, ook deze tip doet het ! :thumb:

Ivm die merged cells:
Hier zal ik weinig aan kunnen veranderen, vermits ik deze "bronbestanden" van onze klant ontvang...

Mvg,
Ilja

 

[Wigi]

OK dan

Zet de vraag op opgelost aub. Werkt overzichtelijker.

Wigi

 

[Phyxsius]

Weet je toevallig ook hoe ik automatisch bij het draaien van deze macro de huidige datum (=datum van draaien macro) in een bepaalde cel kan laten invullen ?

En onmiddellijk al een tweede vraag:
In het "bronbestand" staan in sommige cellen gegevens die uit een lijst zijn gekozen. Als ik dit dan met mijn macro kopieer in de "Overview.xls", kopieert hij enkel de positie van deze waarde in de lijst, maar niet de waarde zelf.
Valt hier iets aan te doen ?

Alvast bedankt !

 

[Wigi]

Probeer

Range("A1").Value = Now

en maak A1 op via Opmaak > Celeigenschappen > Getal

Wigi

 

[Phyxsius]

Dank je wel, werkt weer perfect.

Toevallig ook een idee ivm die lijst ? Er staan namelijk veel lijsten in dat "bronbestand"

Ilja

 

[Wigi]

En onmiddellijk al een tweede vraag:
In het "bronbestand" staan in sommige cellen gegevens die uit een lijst zijn gekozen. Als ik dit dan met mijn macro kopieer in de "Overview.xls", kopieert hij enkel de positie van deze waarde in de lijst, maar niet de waarde zelf.
Valt hier iets aan te doen ?

Ilja

je mag van mij gerust 100-en vragen stellen, maar verander geen posts door er nieuwe vragen aan toe te voegen.

Over de lijsten: ik begrijp niet wat je bedoelt. Kan je een voorbeeldbestand aanhangen?

 

[Phyxsius]

Ik zal m'n vragen voortaan apart posten. Ik dacht dat het zo korter en dus overzichtelijker zou blijven.

Anyway, in bijlage de twee bestandjes. Kort woordje uitleg staat in "Bronbestand1.xls"

Alvast bedankt.

Mvg,
Ilja

 

[Wigi]

Je zal via een omweg moeten werken.

1. Zet een koppeling met een cel, bv. J1. Als het eerste element uit de reeks getoond wordt, bevat J1 een 1.

2. In de macro gebruik je (volledige code - waar veranderingen zijn heb ik commentaren gezet. Dan kan je de wijziging zien en hopelijk begrijpen wat er gebeurt.)

Sub Macro1()
'
' Macro1 Macro
' De macro is opgenomen op 30/07/2006 door XP.
'
' Sneltoets: CTRL+k
'
    Dim wbResult As Workbook, wbSource As Workbook, CopyRng As Range, Dest As Range
    Dim FileName As String, Filt As String
    
    Range("B1").Value = Now
        
    Filt = "Excel Files (*.xls),*.xls"
    FileName = Application.GetOpenFilename(Filt)
    
    Set wbResult = ThisWorkbook
    'Set Dest = wbResult.Sheets("Blad1").Range("B4")
    Set Dest = wbResult.Sheets("Blad1").Range("B4")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
      
    Set wbSource = Workbooks.Open(FileName)
    'Set CopyRng = wbSource.Sheets("Blad1").Range("A3")
    Set CopyRng = wbSource.Sheets("Blad2").Range("C2").Offset(wbSource.Worksheets("Blad1").Range("J1"), 0)
    Dest = CopyRng
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    wbSource.Close
    wbResult.Activate
    
    MsgBox "Kopiëren is gebeurd."
End Sub

Wigi

 

[Phyxsius]

Kan je de aangepaste bestandjes er aub bijzetten ?

Thx

 

[Wigi]

Ik heb ze al gedeleted. Wat meer uitleg:

1. Klik rechts op de listbox, op het laatste tabblad stel je J1 in. Als het goed is, verschijnt er in J1 telkens een ander getal wanneer je een ander item kiest.

2. Code die ik gaf kopiëren en plakken in plaats van de vorige code...

1. Zet een koppeling met een cel, bv. J1. Als het eerste element uit de reeks getoond wordt, bevat J1 een 1.

2. In de macro gebruik je (volledige code - waar veranderingen zijn heb ik commentaren gezet. Dan kan je de wijziging zien en hopelijk begrijpen wat er gebeurt.)

 

[Phyxsius]

OK, ik heb het beet. Dankjewel.