Fetch values from merged cells in macro

[dhivya.enjoy]

Hi Team,

As per my attached template I will have entries in column Y in merged cells. Those merged cell values belong to the same row of sample 2.
I am working on a development of macro where from these entries in excel I will fetch multiple csv files to upload in oracle tables through my web application.

Csv extraction all is working fine with the help of this forum. Now I need to fetch the values from this merged cell and in csv i need to put these values in two separate rows . For eg. refer attached sheet with filename sample_csv.

Also there is a single row space between each sample in the excel named TEMPLATE_EXCEL, when I extract csv I need to ignore these row spaces and put the entry in csv without any row spaces so please do help me with this also

Kindly help me with the code for both the need

Thanks in advance

Regards
Dhivya

[dhivya.enjoy]

Hi Team,

As per my attached template I will have entries in column Y in merged cells. Those merged cell values belong to the same row of sample 2.
I am working on a development of macro where from these entries in excel I will fetch multiple csv files to upload in oracle tables through my web application.

Csv extraction all is working fine with the help of this forum. Now I need to fetch the values from this merged cell and in csv i need to put these values in two separate rows . For eg. refer attached sheet with filename sample_csv.

Also there is a single row space between each sample in the excel named TEMPLATE_EXCEL, when I extract csv I need to ignore these row spaces and put the entry in csv without any row spaces so please do help me with this also

Kindly help me with the code for both the need

Thanks in advance

Regards
Dhivya

Hi Team,

Any ideas for my query.

[Admin]

Hi

try this


Sub kTest()

Dim k, i As Long, j As Long, a() As String, n As Long
Dim wbkNew As Workbook, r As Range, c As Long

With Worksheets("Sheet1")
On Error Resume Next
With .Range("a2:ac" & .UsedRange.Rows.Count)
Set r = .Columns(1).SpecialCells(xlCellTypeConstants, 23)
c = .Columns.Count
End With
End With
If Not r Is Nothing Then
For i = 1 To r.Areas.Count
With r.Areas(i).Resize(, c)
Debug.Print .Address
.UnMerge
.SpecialCells(4).FormulaR1C1 = "=r[-1]c"
k = .Value2
End With
For j = 1 To UBound(k, 1)
n = n + 1
ReDim Preserve a(1 To n)
a(n) = Join(Application.Index(k, j, 0), "|")
Next
Next
If n Then
Set wbkNew = Workbooks.Add(xlWBATWorksheet)
With wbkNew.Worksheets(1)
.Range("a1").Resize(n) = Application.Transpose(a)
.Range("a1").Resize(n).TextToColumns .Range("A1"), 1, Other:=True, OtherChar:="|"
.Range("i1").Resize(n).TextToColumns .Range("i1"), 1, , FieldInfo:=Array(1, 5)
.Range("j1").Resize(n).TextToColumns .Range("j1"), 1, , FieldInfo:=Array(1, 5)
End With
wbkNew.SaveAs ThisWorkbook.Path & "\" & "CSVFileName.CSV", 6
wbkNew.Close 0
Set wbkNew = Nothing
End If
End If

End Sub

[princ_wns]

let say you have a merge cells A1:C1 then for extracting the data from this you can code it like this.


range("A1:C1").areas(1).cells(1,1)


Regards
Prince