• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

bestanden samenvoegen cel waarde

Status
Niet open voor verdere reacties.

arienlans

Gebruiker
Lid geworden
15 aug 2008
Berichten
172
ik gebruik deze formule

Code:
Sub dataophalen() 'S()
' in: workbooks, de usedrange van de eerste sheet
' uit: nieuw sheet met alle gelezen usedranges
' de eerste rij van elke usedrange moet header zijn, maar
' alleen de header van de 1e wordt overgenomen

    Dim wbSource As Workbook
    Dim shTarget As Worksheet
    Dim sPath As String, sFileMask As String
    Dim sFileName As String
    Dim bIncludeHeaders As Boolean, lTargetRow As Long, r As Range
    
    ' aan te passen variabelen
    sPath = ActiveWorkbook.Path ' pad naar map met bronbestanden
    sFileMask = "week*.xlsm" ' mask voor te lezen bestanden
    
    ' lees naam van eerste bronbestand
    sPath = sPath & "\data\"
    sFileName = Dir(sPath & sFileMask)
    
    ' maak targetsheet
    Application.ScreenUpdating = False
    Set shTarget = Sheets("data")
    
    ' inits
    bIncludeHeaders = True ' eerste keer headers meenemen
    lTargetRow = 1 ' rij in doelsheet waarnaar gekopieerd wordt
    
    Do Until sFileName = ""
    
        ' open bronbestand
        Set wbSource = Workbooks.Open(Filename:=sPath & sFileName)
    
        ' ga uit van UsedRange als de te kopieren range
        Set r = wbSource.Sheets(1).UsedRange
        
        ' alleen iets verwerken als er meer dan een headerrow is
        If r.Rows.Count > 1 Then
        
            If bIncludeHeaders = True Then
                ' eerste doorloop, range blijft volledige usedrange
                bIncludeHeaders = False
            Else
                ' >tweede doorloop, range aanpassen, eerste rij niet mee
                Set r = r.Offset(5, 0).Resize(r.Rows.Count - 1)
            End If
            
            ' kopieer de range
            r.Copy Destination:=shTarget.Cells(lTargetRow, 1)
            
            ' nieuwe TargetRow berekenen
            lTargetRow = lTargetRow + r.Rows.Count
        
        End If
        
        ' bronbestand sluiten
        Application.DisplayAlerts = False
        wbSource.Close
        Application.DisplayAlerts = True
    
        ' lees volgende naam bronbestand
        sFileName = Dir
    
    Loop
    
    Application.ScreenUpdating = True

Sheets("data").Select
End Sub

Om bestanden samen te voegen.

Nu kopieert hij alles alleen neemt de formules over en ik wil dat de celwaarde geplakt word.

Hoe pas ik dit stukje code aan?
Code:
 lTargetRow = lTargetRow + r.Rows.Count
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan