Here you go:
Change constant variable values accordingly (Highlighted with red color)
Code:
Sub Lalit_Test()
Dim varData() As Variant
Dim varFinalData() As Variant
Dim lngTotalDataCell As Long
Dim lngLoop As Long
Dim lngLoop1 As Long
Dim lngCount As Long
Const strDataRange As String = "$A$6:$E$9"
Const strDataShtName As String = "Sheet1"
Const strOutDataCell As String = "$K$13"
With ThisWorkbook.Worksheets(strDataShtName)
.Range(strOutDataCell).Resize(.Rows.Count - .Range(strOutDataCell).Row + 1, 2).ClearContents
varData = .Range(strDataRange).Value
lngTotalDataCell = WorksheetFunction.CountA(.Range(strDataRange)) - .Range(strDataRange).Rows.Count
ReDim varFinalData(1 To lngTotalDataCell, 1 To 2)
lngCount = 0
For lngLoop = LBound(varData) To UBound(varData)
varFinalData(lngCount + 1, 1) = varData(lngLoop, LBound(varData))
For lngLoop1 = LBound(varData) + 1 To UBound(varData, 2)
If LenB(Trim(varData(lngLoop, lngLoop1))) Then
lngCount = lngCount + 1
varFinalData(lngCount, 2) = varData(lngLoop, lngLoop1)
End If
Next lngLoop1
Next lngLoop
If lngCount Then
.Range(strOutDataCell).Resize(UBound(varFinalData), UBound(varFinalData, 2)).Value = varFinalData
End If
End With
Erase varData
Erase varFinalData
lngTotalDataCell = Empty
lngLoop = Empty
lngLoop1 = Empty
lngCount = Empty
End Sub
Bookmarks