copy based on NAMES instead of ID

[GirishDhruva]

Hi Everyone,
Below i have a code which copies based on cell values(Highlighted) but instead of cell values, can we copy through cell name (Cell names which would be only in "Column C")

FolderName = Worksheets("copy").Cells(2, "K").Value & "\"
    If FolderName <> "\" Then
        FileName = Dir(FolderName & "*.xl*")
        If FileName <> "" Then
            Application.ScreenUpdating = False
            While FileName <> ""
                
                Set wbTarget = Workbooks.Open(FileName:=FolderName & FileName, UpdateLinks:=False, ReadOnly:=True)
                i = 1
                For Each cell In wbTarget.Sheets(1).Range("D4:D5,D8,F14:F19").Cells
                    arr(i) = cell.Value
                    i = i + 1
                Next cell
                
                With FBP
                    .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row + 1, 1).Resize(, UBound(arr)).Value = arr
                End With
                
                wbTarget.Close False
                Set wbTarget = Nothing
                Erase arr
                FileName = Dir
            Wend
            Application.ScreenUpdating = True

Cell names would be : Id,Name,class,div,sub1,sub2,sub3,sub4,sub5

Regards,
Dhruva

 

[GirishDhruva]

Thanks @JackDanIce and @Joe4 for your help, It worked.........

i have one last doubt in the below code where my ID,Name,Class,Div would be in 4th column(Column D) and remaining(Sub1,Sub2,Sub3,Sub4,Sub5) would in 6th column(Column F) so i tried to modify but in highlighted row it will overlap the values, so what changes should i make in the highlighted row to get the values one after the other

First i should get my ID,Name,Class,Div then in the same row i should get Sub1,Sub2,Sub3,Sub4,Sub5

And sorry i have not noticed the Above changes to inform you earlier

Private Sub CopyData(ByRef sFile As String, ByRef r As Range)


    Dim a   As Variant: a = Array("Sub1","Sub2","Sub3","Sub4","Sub5")
    Dim b   As Variant: b = Array("ID","Name","Class","Div")
    Dim LR, LR1 As Long
    Dim x, y  As Long
    
    With Workbooks.Open(sFile, False, True)
        With .Sheets(1)
            LR = .Cells(.Rows.Count, 3).End(xlUp).Row
            For x = LBound(a) To UBound(a)
                'Search column C for headers, return values from column F
                On Error Resume Next
                a(x) = .Cells(1, 3).Resize(LR).Find(what:=a(x), lookat:=xlWhole, searchorder:=xlByColumns).Offset(, 3).Value
                On Error GoTo 0
            Next x
            LR1 = .Cells(.Rows.Count, 3).End(xlUp).Row
            For y = LBound(b) To UBound(b)
                'Search column C for headers, return values from column D
                On Error Resume Next
                b(y) = .Cells(1, 3).Resize(LR1).Find(what:=b(y), lookat:=xlWhole, searchorder:=xlByColumns).Offset(, 1).Value
                On Error GoTo 0
            Next y
        End With
    End With
    ActiveWorkbook.Close
    r.Resize(, UBound(b)).Value = b
    r.Resize(, UBound(a)).Value = a
    Erase a
    Erase b
End Sub

 

[JackDanIce]

Not sure what you mean, but perhaps:

r.Resize(, uBound(b)).value = b
r.Offset(1).Resize(, uBound(a)).value = a

r is the cell you are writing contents of array b to, then your code is replacing it with contents of array a because you're still resizing relative to the r cell, not moving away from the cell (by row or column)

 

[GirishDhruva]

Not sure what you mean, but perhaps:

r.Resize(, uBound(b)).value = b
r.Offset(1).Resize(, uBound(a)).value = a

r is the cell you are writing contents of array b to, then your code is replacing it with contents of array a because you're still resizing relative to the r cell, not moving away from the cell (by row or column)

Excellent it worked but i wanted to use like below code

r.Resize(, UBound(b)).Value = b
r.Offset(0,4).Resize(, UBound(a)).Value = a

Thankyou so much @ JackDanIce for your help and suggestions
And also thank you @Joe4 for your help

 

[JackDanIce]

You're welcome, glad it's resolved