Find columns dynamically

[OctavianS]

Hello all! I am glad to be part of this community, I've been a long time lurker here but this will be my first post here.

I need a way to find columns dynamically meaning that I need to copy columns from a workbook to another based on some column names from a row. The application we are working on is still in development so changes may come and go anytime. I need a way to not be forced to select specific columns, but columns that has the value X in a specific row.

This macro is basically opening multiple excel files and copies the data from them on a master cell, below each other. It looks like that so far:

Sub Macro()

Dim CurrentBook As Workbook
Dim ws As Worksheet
Set ws = Workbooks("Master").Sheets(1)
Dim Row As Long, LastRow As Long, FirstRow As Long
Dim IndvFiles As FileDialog
Dim FileIdx As Long
Dim i As Integer, x As Integer
Dim rng As Range
Dim rngselected As Range
Dim LastCol As Long

Set IndvFiles = Application.FileDialog(msoFileDialogOpen)
With IndvFiles
    .AllowMultiSelect = True
    .title = "Multi-select target Identificator files:"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xls* files", "*.xls*"
    .Show
End With

Application.DisplayAlerts = False
Application.ScreenUpdating = False

ActiveSheet.name = "Devize Aplicatie"

Range("A1").Value = "Column 1"
Range("B1").Value = "Identificator"
Range("C1").Value = "Service"
Range("D1").Value = "ID"
Range("E1").Value = "ID Location"
Range("F1").Value = "ID Value"
Range("G1").Value = "Sub ID"
Range("H1").Value = "Price"
Range("A1:H1").Select
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 90
        .Gradient.ColorStops.Clear
    End With
    With Selection.Interior.Gradient.ColorStops.Add(0)
        .Color = 15959521
        .TintAndShade = 0
    End With
    With Selection.Interior.Gradient.ColorStops.Add(0.5)
        .Color = 10498160
        .TintAndShade = 0
    End With
    With Selection.Interior.Gradient.ColorStops.Add(1)
        .Color = 15959521
        .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 90
        .Gradient.ColorStops.Clear
    End With
    With Selection.Interior.Gradient.ColorStops.Add(0)
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.400006103701895
    End With
    With Selection.Interior.Gradient.ColorStops.Add(0.5)
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior.Gradient.ColorStops.Add(1)
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.400006103701895
    End With
    Rows("1:1").RowHeight = 31.8
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    

For FileIdx = 1 To IndvFiles.SelectedItems.Count
    Set CurrentBook = Workbooks.Open(IndvFiles.SelectedItems(FileIdx))
    For Each Sheet In CurrentBook.Sheets
        FirstRow = 1
        LastRow = CurrentBook.Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
        CurrentBook.Sheets(1).UsedRange.UnMerge
        CurrentBook.Sheets(1).Cells.EntireColumn.AutoFit
        
        CurrentBook.Sheets(1).Cells.Replace What:=ChrW(537), Replacement:="s", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
        , FormulaVersion:=xlReplaceFormula2
        CurrentBook.Sheets(1).Cells.Replace What:=ChrW(536), Replacement:="S", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
        , FormulaVersion:=xlReplaceFormula2
        CurrentBook.Sheets(1).Cells.Replace What:=ChrW(351), Replacement:="s", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
        , FormulaVersion:=xlReplaceFormula2
        CurrentBook.Sheets(1).Cells.Replace What:=ChrW(350), Replacement:="S", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
        , FormulaVersion:=xlReplaceFormula2
        CurrentBook.Sheets(1).Cells.Replace What:=ChrW(538), Replacement:="t", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
        , FormulaVersion:=xlReplaceFormula2
        CurrentBook.Sheets(1).Cells.Replace What:=ChrW(539), Replacement:="T", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
        , FormulaVersion:=xlReplaceFormula2
        CurrentBook.Sheets(1).Cells.Replace What:=ChrW(258), Replacement:="a", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
        , FormulaVersion:=xlReplaceFormula2
        CurrentBook.Sheets(1).Cells.Replace What:=ChrW(259), Replacement:="A", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
        , FormulaVersion:=xlReplaceFormula2
        CurrentBook.Sheets(1).Cells.Replace What:=ChrW(226), Replacement:="a", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
        , FormulaVersion:=xlReplaceFormula2
        CurrentBook.Sheets(1).Cells.Replace What:=ChrW(194), Replacement:="A", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
        , FormulaVersion:=xlReplaceFormula2
        
        For Row = LastRow To FirstRow Step -1
                    If CurrentBook.Sheets(1).Range("A" & Row).Value = "ID Value" Then
                    CurrentBook.Sheets(1).Range("A" & Row).Offset(-1, 1).FormulaR1C1 = _
                        "=TRIM(MID(RC[-1], SEARCH("": "",RC[-1])+2, SEARCH("": "",RC[-1],SEARCH("": "",RC[-1])+1) - SEARCH("": "",RC[-1])-1 - SEARCH("": "",RC[-1])-1))"
                    CurrentBook.Sheets(1).Range("A" & Row).Offset(-1, 1).Value = CurrentBook.Sheets(1).Range("A" & Row).Offset(-1, 1).Value
                    End If
                    If CurrentBook.Sheets(1).Range("N" & Row).Value = "Sucursala IDa" Then
                    CurrentBook.Sheets(1).Range("N" & Row).Offset(0, 1).Value = "Service"
                    End If
        Next Row
        
        For Row = LastRow To FirstRow Step -1
                    If CurrentBook.Sheets(1).Range("B" & Row).Value <> "" Then
                    CurrentBook.Sheets(1).Range("E" & Row).Offset(2, 0).Select
                    CurrentBook.Sheets(1).Range(Selection, Selection.End(xlDown)).Offset(0, 10).Value = CurrentBook.Sheets(1).Range("B" & Row).Value
                    End If
        Next Row
        
        Dim LRow1 As Long
        LRow1 = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        Dim LRow2 As Long
        LRow2 = CurrentBook.ActiveSheet.Range("A" & CurrentBook.ActiveSheet.Rows.Count).End(xlUp).Row

        Dim importrange As Range
        
        For Each rng In CurrentBook.Sheets(1).Range("A15:BA15")
        
        If rng.Value = "ID Value" Then
        Set importrange = CurrentBook.Sheets(1).rng.EntireColumn.Select
        importrange.Copy
        ws.Range("A" & LRow1 + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
        
        Next rng
        
    Next
    CurrentBook.Close savechanges:=True
Next FileIdx

With ws
    FirstRow = 2
    LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
    For Row = LastRow To FirstRow Step -1
        If .Range("A" & Row).Value = "Sucursala expeditoare" Or .Range("A" & Row).Value = "" Then
            .Range("A" & Row).EntireRow.delete
            
        End If
    Next Row
End With

ws.Cells.EntireColumn.AutoFit
LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("B2:B" & LastRow).NumberFormat = "dd.mm.yyyy"

'With ActiveWindow
'    .SplitColumn = 0
'    .SplitRow = 1
'End With
'ActiveWindow.FreezePanes = True

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Thanks!