VBA copy uit gesloten bestanden plakken in kolommen inplaats van rijen

[arienlans]

deze code heb ik nu

Sub OpenLeesSluitFiles()
    Const BronPad As String = "mijn pad\"
    Dim BronBoek As String, BronPadBoek As String
    Dim BronSheet As Worksheet, DoelSheet As Worksheet
    Dim RijLoper As Long
    
    Set DoelSheet = ActiveWorkbook.Worksheets(1)
    DoelSheet.Range("A:Z").ClearContents ' Doel wissen
    BronBoek = Dir(BronPad & "*.xlsm") ' eerste bronboek lezen
    RijLoper = 3 ' beginnen met plakken op regel
    ' Application.ScreenUpdating = False
    Do Until BronBoek = ""
        BronPadBoek = BronPad + BronBoek
        Workbooks.Open Filename:=BronPadBoek, ReadOnly:=True
        Set BronSheet = ActiveWorkbook.Worksheets(3)
        ' hyperlink maken
        DoelSheet.Hyperlinks.Add _
            Anchor:=DoelSheet.Range(Cells(RijLoper, 1).Address), _
            Address:=BronPadBoek, _
            TextToDisplay:=BronBoek
         ' volgende regels bepalen de copy van bron naar doelcellen
        DoelSheet.Cells(RijLoper, 2) = BronSheet.Range("b6")
        DoelSheet.Cells(RijLoper, 3) = BronSheet.Range("b16")
        ' etc
        ActiveWorkbook.Close SaveChanges:=False
        BronBoek = Dir ' volgende bronboek lezen
        RijLoper = RijLoper + 1
    Loop
    ' Application.ScreenUpdating = True
End Sub

Nu word het in de rijen geplakt maar ik wil het in de kolommen plakken.

Ariën

 

[Warme bakkertje]

Als ik je vraag goed begrijp

Sub OpenLeesSluitFiles()
    Const BronPad As String = "mijn pad\"
    Dim BronBoek As String, BronPadBoek As String
    Dim BronSheet As Worksheet, DoelSheet As Worksheet
    Dim KolomLoper As Long
    
    Set DoelSheet = ActiveWorkbook.Worksheets(1)
    DoelSheet.Range("A:Z").ClearContents ' Doel wissen
    BronBoek = Dir(BronPad & "*.xlsm") ' eerste bronboek lezen
    KolomLoper = 1 ' beginnen met plakken in kolom 1
    ' Application.ScreenUpdating = False
    Do Until BronBoek = ""
        BronPadBoek = BronPad + BronBoek
        Workbooks.Open Filename:=BronPadBoek, ReadOnly:=True
        Set BronSheet = ActiveWorkbook.Worksheets(3)
        ' hyperlink maken
        DoelSheet.Hyperlinks.Add _
            Anchor:=DoelSheet.Range(Cells(3, KolomLoper).Address), _
            Address:=BronPadBoek, _
            TextToDisplay:=BronBoek
         ' volgende regels bepalen de copy van bron naar doelcellen
        DoelSheet.Cells(4, KolomLoper) = BronSheet.Range("b6")
        DoelSheet.Cells(5, KolomLoper) = BronSheet.Range("b16")
        ' etc
        ActiveWorkbook.Close SaveChanges:=False
        BronBoek = Dir ' volgende bronboek lezen
        KolomLoper = KolomLoper + 1
    Loop
    ' Application.ScreenUpdating = True
End Sub

 

[arienlans]

je heb me goed begrepen. Helemaal top zit ik te hannessen met Columns is het gewoon kolom.

Bedankt

Ariën

 

[arienlans]

unieke getallen uit meerdere kolommen

is het mogelijk om uit meerdere kolommen de unieke getallen te filteren?

voorbeeld toegevoegd in kolom A wil ik de unieke getallen hebben.

Bekijk bijlage unieke getallen.xlsx

Ariën

 

[Warme bakkertje]

Volgens jouw voorbeeld

Sub tst()
For Each cl In Blad1.Range("C2:I29")
    If InStr(c01, cl.Value) = 0 Then c01 = c01 & "|" & cl.Value
Next
With Blad1.Range("A2")
    .CurrentRegion.ClearContents
    .Resize(UBound(Split(c01, "|"))) = Application.Transpose(Split(Mid(c01, 2), "|"))
End With
End Sub

Het is wel mogelijk dat je de lijst nog moet sorteren.

 

[arienlans]

super precies wat ik zocht

bedankt.

Ariën