Sub Copy_data()
    Dim FilesToOpen
    Dim x As Integer
    Dim a(), i As Long, b As Long
    Dim lis As String
    
    Application.ScreenUpdating = False

 On Error GoTo EH
    
    FilesToOpen = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Select files to open"
        Exit Sub
    End If
    
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
        
        Workbooks(importWB.Name).Sheets("info").Activate
        a = Workbooks(importWB.Name).Sheets("info").Range("C6,C7,H5").Value

        b = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
        
        For i = 1 To 3
            Select Case i
                Case 1 To 3: s = i
            
            End Select
         
            ThisWorkbook.Sheets("Sheet1").Cells(b, i) = a(s, 1)
        
        Next

        importWB.Close savechanges:=False
        x = x + 1
    Wend

    Application.ScreenUpdating = True
    
    Exit Sub
    
EH:
    MsgBox "Info is copied"
    Application.ScreenUpdating = True
    
End Sub

=INDEX(A1:G1;1;LARGE(COLUMN(A1:G1)*(A1:G1>0)*ISODD(COLUMN(A1:G1));2))
=CHOOSE(LARGE({1;2;3;4}*(CHOOSE({1;2;3;4};A1;C1;E1;G1)>0);2);A1;C1;E1;G1)