how to merge data from multiple cell based on condition + EXCEl + VBA

• deeep

  SSC Eights!

  Points: 950

  More actions

  November 21, 2008 at 2:30 am

  #196112

  hi i am looking for a macro which can full fill my purpose of copying data from sheet1 to sheet3 in the following format

  let say below all cells contents ,(i have differentiated them by "|" symbol) are part of a single Row of XL Sheet.

  Step 1|Description:|Start SQL Server Management Studio and connect to the server hosting the TescoDotComReporting data base.|Server type: Database Engine|Server name: |INT34RPT02V for INT or OPS34RPT02V for OPS [dependant on required environment]|Authentification: Windows Authentification|Expected:|Logged in with access to required data sets|

  now i want to merge the data on the following condition

  Sep1, Description: Expected

  condition :

  1.the data which comes between Step -Description will come under Step

  2. data in the cells which comes between Description-Expected will come under Description.

  3. the data After Description in the row will come under Description.

  exapmle

  Row1.Step| Desciption | ExpetedRow2. |Start SQL Server |Logged in with access

  | Management Studio |required data sets

  |and connect to the server |

  |hosting the TescoDotComReporting |

  |data base

  the pipe "|" showing the Cells Differentiater , the data which will be in Row2 will be wrap text within their respecitve cells.

  Please provide the macro codes ,,

  --------------------------------------------------------------------------The macor which i have written find in the sample///

  thi macro pick the data from sheet1 which contain the data row wise

  Step

  Description:

  kkgjoljdgoijoigjdojgo

  Expected:

  jkjgkjas gaklsdjglkasdg kjgkl

  this type of data will be in the entire sheet. and the rows can be mulitple in Description,Expected Headings.thts why they will be trasposed to multiple cells in a same Row------------

  Sub Macro1()

  '

  ' Macro1 Macro

  ' '

  ' Keyboard Shortcut: Ctrl+Shift+M

  '

  Dim MidRow As Range

  Dim lastRow As Integer

  Dim RCount As Integer

  Cells.Find(What:="Step", After:=ActiveCell, LookIn:=xlFormulas, LookAt _

  :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _

  False, SearchFormat:=False).Activate

  RCount = ActiveCell.Row

  Range("A1:A" & RCount - 1).Select

  Range("A" & RCount - 1).Activate

  Selection.Copy

  Sheets("sheet1").Activate

  Sheets("sheet3").Activate ' Enter name of your sheet to copy to

  'ActiveSheet.Paste //without Transpose

  Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

  False, Transpose:=True

  Set MidRow = ActiveSheet.Cells.SpecialCells(xlLastCell)

  Range("C" & MidRow).Select

  Application.CutCopyMode = False

  Selection.Cut

  Range("B" & MidRow + 1).Select

  ActiveSheet.Paste

  Range("E" & MidRow).Select

  Selection.Cut

  Range("D" & MidRow + 1).Select

  ActiveSheet.Paste

  Range("D" & MidRow).Select

  Columns("C:C").EntireColumn.AutoFit

  Range("B" & MidRow + 1).Select

  With Selection

  .HorizontalAlignment = xlGeneral

  .VerticalAlignment = xlBottom

  .WrapText = True

  .Orientation = 0

  .AddIndent = False

  .IndentLevel = 0

  .ShrinkToFit = False

  .ReadingOrder = xlContext

  .MergeCells = False

  End With

  Range("D" & MidRow + 1).Select

  With Selection

  .HorizontalAlignment = xlGeneral

  .VerticalAlignment = xlBottom

  .WrapText = True

  .Orientation = 0

  .AddIndent = False

  .IndentLevel = 0

  .ShrinkToFit = False

  .ReadingOrder = xlContext

  .MergeCells = False

  End With

  lastRow = MidRow.Row + 2

  Rows(lastRow).Select

  Range("A" & lastRow).Select

  Sheets("Sheet1").Select

  Application.CutCopyMode = False

  Selection.Delete Shift:=xlUp

  Range("A1").Select

  'Selection.Copy

  End Sub