Sheets importeren met macro

[ivoexcel]

Goedendag excel-kenners,

Ik heb de volgende vraag. Ik heb een Excelbestand dat gaat dienen als totaal overzicht van een jaar. Elke week komt er een Excel output die gekopieerd moet gaan worden in het nieuwe bestand.
Dit importeren zou ik graag op de volgende manier doen:

vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select One File To Open", , False)

Ofwel.. je kunt het bestand selecteren dat gekopieerd moet worden.

In de bijlage voorbeelden van de bestanden waar het om gaat. Totaaloverzicht moet de macro in komen en wordt zoals de naam al zegt het totaal en import is het bestand waarvan elke week een nieuwe komt.

Zoals je in de excel bestanden ziet is het te kopieren bestand 1 blad met 4 hoofdgroepen (nu genoemd gegevens 1, gegevens 2 ezv.) De waardes die hieronder staat moet de macro in het juiste blad plakken van het overzicht bestand (waar deze 4 hoofdgroepen elk een tabblad hebben).

Moeilijkheid:
Het import bestand heeft altijd deze 4 hoofdgroepen alleen verschilt het aantal regels per groep per keer
Het aantal kollommen kan ook nog wijzigen deze zou ik dus graag willen bepalen als dit kan


Dan nog een extra uitdaging als dat gaat maar is niet perse nodig:
Is het mogelijk dat er iets in de macro zit dat controleert of het bestand niet al ingelezen is. (zodat het dus nier per ongeluk 2x gekopieerd wordt.

Ik hoop dat iemand mij hiermee kan helpen. mijn dank is nu al groot!

Groet,

Ivo

 

[VenA]

Wat wil je importeren dan?

 

[ivoexcel]

De waardes in het excel bestand moeten gekopieerd worden naar het andere bestand zoals hierboven uitgelegd

 

[cow18]

die getopenfilename vond ik geen zo'n uitdaging, daar staan hier anders al tig voorbeelden van.
De rest zit in de file hieronder.
Een check op eerdere import, hoe kan dat ? Kijken of 1e datum in nieuwe import recenter is dan de laatste datum in de vroegere imports ?

 

[ivoexcel]

Hoi Cow18,

Heel erg bedankt dit lijkt er al aardig op!

Alleen wil ik toch graag met het volgende keuze menu omdat de naam van het te kopieren bestand niet altijd hetzelfde hoeft te zijn.

   'Bestand openen en selecteren
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
1, "Select One File To Open", , False)

 

[snb]

Dan terug naar de bron:

Als je iedere keer het in te lezen bestand verwijdert nadat de gegevens zijn geïmporteerd, is de directory van in te lezen bestanden leeg.
Zo gauw er een bestand in staat, met welke naam dan ook, moet dat geïmporteerd en vervolgens verwijderd worden.
Iedere vergissingsgevoelige gebruikersbemoeienis is zo overbodig.

 

[ivoexcel]

De bedoeling is dat er er niks gedaan wordt in het te importeren bestand. Deze wordt op geslagen onder een titel + weeknummer en vervolgens geimporteerd. vanuitdaar wordt er pas iets mee gedaan.

Zoals gezegd is daarom de invoeg pop-up handig omdat je dan niet zelf het bestand hoeft te opene omdat dat inprincipe niet nodig is.

 

[snb]

Lees mijn bericht nog eens rustig door.

 

[ivoexcel]

Ik begrijp wat u zegt maar de bestanden die geimporteerd worden worden opgeslagen in een eigen map en deze moeten daar bewaard blijven. Er kan dus niets verwijderd worden.

 

[snb]

Dan is de directory met de importbestanden toch leeg ?

 

[ivoexcel]

Met de code hieronder gebeurt er precies wat ik moet hebben. Het enige dingetje nu is:

In het voorbeeld bestand heb ik de bladen en de te kopieeren gegevens de titels: gegevens 1, gegevens 2 ezv.
In werkelijkheid hebben de 4 bladen een naam die iets afwijkt van de titels boven het te kopieren stukje.

Blad 2 t/m 4 in het bestand ''totaal overzicht'' zijn de bladen waar in de gegevens in geplakt mogen worden. Hoe kan ik nu aangeven aan welke ''titel'' uit het importblad dit gelinkt mag worden?

Sub Importeren_test()
    Dim bLoop As Boolean, i As Variant, sGegevens As String


'Bestand openen en selecteren
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select One File To Open", , False)

'Als er geen file geselecteerd wordt, macro beeindigen
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile

'Werkblad openen
Set wb2 = ActiveWorkbook

With wb2.Sheets("financiële weekafsluiting")                            'dat is al je importblad
        sn = .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row)    'de B-kolom interesseert me, dus in een array zetten
        bLoop = True
        Do While bLoop
            i = Application.Match("filiaalnummer", sn, 0)            'zoek "filiaalnummer" in die array van de B-kolom
            If IsNumeric(i) Then                                     'gevonden
                sGegevens = .Range("B" & i - 4).Value                '4 rijen erboven staat je gegevenX
                sn1 = .Range("B" & i).CurrentRegion.Offset(1)        'vanaf volgende rij je gewenste gegevens, desnoods hier een resize(,x) bij voor gewenst aantal kolommen
                Err.Clear
                On Error Resume Next
                If UBound(sn1, 2) > 1 Then
                    With ThisWorkbook.Sheets(sGegevens)              'werkblad in je totaalbestand
                        .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(sn1), UBound(sn1, 2) - 1).Value = sn1    'gegevens kopieren zonder subtotaal
                    End With
                End If
                If Err.Number <> 0 Then MsgBox "er is iets fout gegaan met de gegevens van " & sGegevens
                On Error GoTo 0
                sn(i, 1) = "--"                                      'filiaalnummer wissen in array
            Else
                bLoop = False
            End If
        Loop

'Bestand waaruit de kopie komt sluiten
wb2.Close
    
    End With
End Sub

 

[cow18]

gelieve de select case aan te passen naar je wensen, dus daar zullen nog enkele extra cases in komen te zitten.
Voor de gevallen dat shNaam en sGegevens overeenkomen, moet je niets doen, die zitten in de "Case else"
2e mogelijkheid was om dit buiten vba, dus via een tabel ergens in een werkblad het verband te leggen, dat is ook te overwegen, als er straks nog veel nieuwe "GegevensX" en werkbladen moeten toegevoegd worden.
Dan moet er niets meer aan de code veranderd worden.

If UBound(sn1, 2) > 1 Then
                    Select Case sGegevens                            'afhankelijk van de naam van je gegevens een blad kiezen
                        Case "Gegevens1": shNaam = "Gegevens1 en iets anders"    'voor gegevens1
                        Case "Gegevens2", "Gegevens20": shNaam = "Gegevens 2"    'voor gegevens2 en 20 mogen op hetzelfde blad met iets andere naam
                        Case Else: shNaam = sGegevens                'alle andere gevallen komen beiden overeen
                    End Select
                    
                    With ThisWorkbook.Sheets(shNaam)                 'werkblad in je totaalbestand
                        .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(sn1), UBound(sn1, 2) - 1).Value = sn1    'gegevens kopieren zonder subtotaal
                    End With
                End If

 

[ivoexcel]

Top dit is precies wat ik nodig had! dankjewel!

 

[ivoexcel]

1 dingetje nog.. Wanneer de laaste kolom een getal bevat dan neemt hij deze niet mee in de kopie. Hoe pas ik dit aan?

 

[cow18]

bij die sn1 het gewenst aantal kolommen invullen, zo te zien is dat iedere keer ook een beetje anders, dus misschien gewoon het maximale aanhouden ???

 sn1 = .Range("B" & i).CurrentRegion.Offset(1)[COLOR="#FF0000"].resize(,16) [/COLOR]       'vanaf volgende rij je gewenste gegevens, desnoods hier een resize(,x) bij voor gewenst aantal kolommen

 

[ivoexcel]

aii... domme vraag dit had ik zelf ook wel kunnen bedenken.

Iets heel anders zou het nu ook mogelijk zijn om in elke regel de eerste lege cel een formule te plakken? zodat deze niet standaard in de sheet hoeft te staan?

 

[cow18]

ik ging er eens van uit dat er al een formule stond in de laatste rij van de vorige keer en dat ik die enkel moest doorkopieren.

With ThisWorkbook.Sheets(shNaam)                                 'werkblad in je totaalbestand
        With .Range("B" & Rows.Count).End(xlUp).Offset(1)
            .Resize(UBound(sn1), UBound(sn1, 2) - 1).Value = sn1                                             'nu kopieer je naar de B-kolom
            .Offset(-1, -1).Copy    'de formule die in de rij erboven in de A-kolom stond
            .Offset(, -1).Resize(UBound(sn1)).PasteSpecial xlPasteFormulas 'doorkopieren naast de nieuwe gegevens
        End With
    End With

Is dit niet het gewenste, geef anders eens een voorbeeldje

 

[ivoexcel]

Zou na het kopiëren van de gegevens in bijvoorbeeld kolom G achter elke gevulde regel de volgende formule kunnen uitvoeren:
=VERT.ZOEKEN(A3;BLADA:E;5;ONWAAR)

 

[cow18]

mogelijks dit ?
Ik; ben geen voorstander om ganse kolommen te selecteren, daarom heb ik de 1e 10.000 rijen gebruikt.

    With ThisWorkbook.Sheets(shNaam)                                 'werkblad in je totaalbestand
        With .Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Resize(UBound(sn1), UBound(sn1, 2) - 1).Value = sn1     'nu kopieer je naar de Akolom
            .Offset(, 6).Resize(UBound(sn1)).FormulaR1C1 = "=VLOOKUP(RC[-6],BladA!R1C1:R10000C5,5,0)"    'in de G-kolom deze formule zetten
        End With
    End With

 

[ivoexcel]

Danku! en stel nu ik wil deze fomule alleen op blad 2 en niet op de andere 3 bladen?