vba transform data

vba-Transform data.vb

Sub execute()
    Dim sourceNameSheet As String: sourceNameSheet = "свод"
    Dim parseNameSheet As String: parseNameSheet = "parse"

    Dim sourceWs As Worksheet
    Set sourceWs = ActiveWorkbook.Worksheets(sourceNameSheet)
    Dim targetWs As Worksheet
    Set targetWs = ActiveWorkbook.Worksheets(parseNameSheet)

    Dim startRow As Long: startRow = 2
    
    Dim rowConuntTargetSheet As Long: rowConuntTargetSheet = 2
    
    Do While (sourceWs.Cells(startRow, 1) <> "")
        Dim nameTY As String
        Dim dateData As String
        Dim nameGm As String: nameGm = sourceWs.Cells(startRow, 3)

        For c = 5 To 47
            nameTY = sourceWs.Cells(1, c)
            dateData = sourceWs.Cells(startRow, c)
            
            rowConuntTargetSheet = checkAndCopyToSheet(targetWs, "2018", "18", dateData, "-", nameTY, nameGm, rowConuntTargetSheet)
        Next c
        startRow = startRow + 1
        
        Debug.Print "process row: " & CStr(startRow)
    Loop
    Debug.Print "process complete"
End Sub

Private Function checkAndCopyToSheet(targetWs, checkValue, checkValue1, dateData, nameMonth, nameTY, nameGm, rowConuntTargetSheet) As Long
    If InStr(dateData, checkValue) > 0 Or InStr(dateData, checkValue1) > 0 Then
        targetWs.Cells(rowConuntTargetSheet, 1) = nameTY
        targetWs.Cells(rowConuntTargetSheet, 2) = nameMonth
        targetWs.Cells(rowConuntTargetSheet, 3) = nameGm
        targetWs.Cells(rowConuntTargetSheet, 4) = dateData
        rowConuntTargetSheet = rowConuntTargetSheet + 1
    End If
    checkAndCopyToSheet = rowConuntTargetSheet
End Function