Sub FetchArticles()
    MsgBox "You have to have selected the row with column headers"

    Dim dataWorksheet As Worksheet
    Set dataWorksheet = GetDataWorksheet()

    Dim cell As Range
    Dim articleNumber As Integer
    articleNumber = 1
    For Each cell In dataWorksheet.Rows(1).Cells
        If StrComp(cell.Value, "Artikl") = 0 Then
            LoadArticle cell, articleNumber
            articleNumber = articleNumber + 1
        End If
    Next cell

End Sub

' Retrieves worksheet name from the user and returns worksheet object with that name.
Function GetDataWorksheet() As Worksheet
    ' Get worksheet name from the user, where the data is located
    Dim worksheetName As String
    worksheetName = InputBox("Enter name of the worksheet", "Data")

    ' Check if worksheet name is empty, if it is, exit the script
    If StrComp(worksheetName, "") = 0 Then
        MsgBox "Operation cancelled"
        Exit Function
    End If

    ' Get the worksheet with the name that the user entered...
    Set GetDataWorksheet = Worksheets(worksheetName)
End Function

' Loads shop numbers and their values to specified row in the to-be-filled worksheet
' articleCell points to cell with string "Artikl" at the top of the table in data worksheet
' articleNumber is the number of the currently found article (line number for the to-be-filled worksheet)
Sub LoadArticle(articleCell As Range, articleNumber As Integer)
    Dim articleID As String
    Dim cellOnRight As Range
    Set cellOnRight = articleCell.Offset(0, 1)
    articleID = cellOnRight.Value
    'Write it to appropriate line
    Dim found As Range
    Set found = Selection.Find(What:="Èíslo zboží")
    found.Offset(1 + articleNumber, 0).Value = articleID

    ' Now we will start going through shop numbers and fill the appropriate values in
    ' currCell points at the current cell in the data worksheet
    Dim currCell As Range
    Set currCell = articleCell.Offset(4, 0)

    ' And found will point at the cell with correct shop number in the to-fill-in worksheet
    Do While StrComp(currCell.Value, "") <> 0
        ' First, find cell with the same shop number as currCell
        Set found = Selection.Find(What:=currCell.Value)

        Dim cellToFill As Range
        ' Cell to fill points at the cell to be currently filled in the to-fill-in worksheet
        Set cellToFill = found.Offset(1 + articleNumber, 0)
        ' Fill the cell to fill with the value from the data-sheet
        cellToFill.Value = currCell.Offset(0, 4).Value
        ' Slide to the next cell (shop number) in this article
        Set currCell = currCell.Offset(1, 0)
    Loop
End Sub