Uit willekeurig bestand gegevens kopiëren naar huidig bestand.

[gersa]

Hallo,
Ik wil m.b.v een macro gegevens uit een bestaand bestand kopiëren naar de nieuwste versie van dit bestand (bestanden hebben uiteraard verschillende namen).
Omdat deze actie door verschillende mensen op hun PC, waar de bestanden andere namen kunnun hebben, moet worden uitgevoerd, wil ik beide bestanden hernoemen.
Met het huidige bestand lukt dit wel, maar hoe doe ik dat met het nieuwe.
Ik had de volgende oplossing bedacht, maar die werkt dus niet.

Dim Bestand As Variant

'HUIDIG BESTAND DEFINIËREN ALS Workbook_Nw

Set Workbook_Nw = ThisWorkbook
    
' OUDE BESTAND INLEZEN

    Bestand = Application.GetOpenFilename("Excel-files,.*", 1, "Select One File To Open", , False)
    Workbooks.Open Bestand
   Set Workbook_Oud = Bestand : 'HIER GAAT HEET FOUT!!!!!!!!!!!!!!!!!!!!!!!

 'KOPIËREN VAN OUDE NAAR NIEUWE BESTAND

    Workbook_oud.Activate
    Sheets(1).Select
    Range("B2:B8").Select
    Selection.Copy
    Workbook_Nw.Activate
    Sheets(1).Select
    Range("B2:B8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Alvast bedankt,
Gerard

 

[Neuz]

Beste Gerard,

Ik ben even bezig geweest met je probleem en ben op het volgende uitgekomen.
Waarschijnlijk kan het script korter of makkelijker (ben beginner) maar deze werkt.

Staat ook nog wat aantekeningen in om het misschien wat makkelijker te maken.

    Dim FD As Office.FileDialog
    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    Set Workbook_New = ThisWorkbook

    With FD
        .AllowMultiSelect = False
        'Titel het pop-up venster
        .Title = "Kies het bestand."
        
        'Hier kan je filters toevoegen (Nu kunnen de mensen filteren op alle bestanden, excel 2003 en excel 2010 bestanden)
        .Filters.Clear
        .Filters.Add "Alle Bestanden", "*.*"
        .Filters.Add "Excel 2003", "*.xls"
        .Filters.Add "Excel 2010", "*.xlsx"
        
        If .Show = True Then
            Workbooks.Open (.SelectedItems(1))
            With ActiveWorkbook
                Sheets(1).Range("B2:B8").Copy
                .Close 'Direkt weer sluiten na het kopieren (is optioneel)
            End With
            
            With Workbook_New
                Sheets(1).Range("B2").Select
                Sheets(1).Paste
            End With
        End If
    End With

Hopelijk heb je er iets aan.

Groet Neuz

 

[gersa]

Beste Neuz,
Bedankt voor je antwoord. Dit werkt inderdaad. Gezien de tijd, je hebt toch niet de hele nacht doorgewerkt om een oplossing voor mij te vinden?
Ik heb nog een vervolg. Ik moet een heleboel ranges van diverse bladen kopiëren. Het liefst zou ik dat met een GOSUB doen.
B.v Rangeoud1 = Range(B2:B8)
Rangein1 = Range B2
Gosub copy
copy
Rangeoud1.select
copy
Rangein1.select
Paste
Return
Bovenstaande simpel opgeschreven.
Bij voorbaat dank.
Gerard
PS je hoeft jezelf geen beginner te noemen!

 

[gersa]

Ik denk. dat ik een oplossing voor mijn tweede bericht heb gevonden.
Ik heb het eerste deel van Neuz overgenomen om het tweede bestand te openen en daarna heb ik het volgende gedaan:

i = 1: ' Sheetnummer
r1 = 2: K1 = 2: r2 = 8: k2 = 2:  ' Cells(r1,k1) = cel linksboven en Cells(r2,k2) is cel rechtsonder van de selectie
GoSub Kopiëren
r1 = 3: K1 = 4: r2 = 13: k2 = 4
GoSub Kopiëren
r1 = 10: K1 = 2: r2 = 10: k2 = 2
GoSub Kopiëren
r1 = 12: K1 = 2: r2 = 12: k2 = 2
GoSub Kopiëren
r1 = 20: K1 = 2: r2 = 22: k2 = 2
GoSub Kopiëren
r1 = 20: K1 = 4: r2 = 21: k2 = 4
GoSub Kopiëren
GoTo Einde

Kopiëren:
 Workbook_Oud.Activate

 Sheets(i).Select
  Range(Cells(r1, K1), Cells(r2, k2)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Workbook_New.Activate
    Sheets(1).Range(Cells(r1, K1), Cells(r2, k2)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Return

Nu hoef ik alleen maar sheet-, regel- en kolomnummers op te geven en kan ik daarna alles met één subroutine afhandelen.
Gerard

 

[Neuz]

Hey Gerard,

Dit is inderdaad de oplossing.

Succes en zet je vraag nog even op opgelost als je klaar bent.

Groet Neuz