PDA

View Full Version : Copy from Merged Cell to individual cell



vmjamshad
02-27-2017, 10:57 PM
Hi..

I need to get a VBA code to copy data from merged cell to individual cells. Please see the excel sheet format below:
18513
Thanks in advance -- Jamshad

mana
02-28-2017, 03:25 AM
Option Explicit


Sub test()
Dim c As Range
Dim f As Range
Dim s As String

For Each c In Range("d3", Range("d" & Rows.Count).End(xlUp))

Set f = Columns("b").Find(What:=c.Value, LookAt:=xlWhole)

If f Is Nothing Then
s = ""
Else
s = f.Offset(, -1).MergeArea(1).Value
End If
c.Offset(, 1).Value = s
Next

End Sub

p45cal
02-28-2017, 04:42 AM
if you don't mind just converting the merged cells to individual cells then select the merged cells and run:
Sub blah()
With Selection
.MergeCells = False
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
End Sub
Then you can move the columns around.

vmjamshad
02-28-2017, 08:06 AM
Is this dan?

Thanks for the code, but i cannot convert to individual cells as this is a master file and not recommended to change the format. The file has got 100s of data rows and with multiple sheets,

Is there any other way.

Thanks,
Jamshad


if you don't mind just converting the merged cells to individual cells then select the merged cells and run:
Sub blah()
With Selection
.MergeCells = False
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
End Sub
Then you can move the columns around.

p45cal
02-28-2017, 08:14 AM
Well copy the columns to a fresh sheet then.

vmjamshad
02-28-2017, 08:52 AM
'

vmjamshad
02-28-2017, 08:54 AM
Thanks, This helps


Option Explicit


Sub test()
Dim c As Range
Dim f As Range
Dim s As String

For Each c In Range("d3", Range("d" & Rows.Count).End(xlUp))

Set f = Columns("b").Find(What:=c.Value, LookAt:=xlWhole)

If f Is Nothing Then
s = ""
Else
s = f.Offset(, -1).MergeArea(1).Value
End If
c.Offset(, 1).Value = s
Next

End Sub