Data arrange in specific format

[Abhijeet]

I have data like this I want this data goes in specific format.In Column C 2 entries 12345678 number 10.5 & 1.31 (10.5*12.5%) & In Column D 2 entries 12345678 number 120 & 15 (120*12.5%) means total 4 entries of 12345678 Number same as next numbers data range is huge so give me macro attach file i show what is expected result is look like

 

[Luke M]

Where do the Element names come from?
Do we always use 12.5%?

 

[Abhijeet]

Hi Luke M
we can store the Element name & Type Name in excel some where give range from that and if u ask about the amount then yes it is always 12.5% calculate. this is mention in excel last column define the column which element need to use
Element Type
ABC A1
XYZ X1
ABC 12.5 A1 12.5
XYZ 12.5 X1 12.5

 

[Luke M]

Then this is the best I can do.

Sub TransferData()
Dim lastRow As Long
Dim recRow As Long
Dim i As Long
Dim destWS As Worksheet
Dim sourceWS As Worksheet

Application.ScreenUpdating = False
Set sourceWS = Worksheets("Sheet1")
Set destWS = Worksheets.Add(after:=sourceWS)

''Setup the header row
With destWS
    .Range("A1").Value = "Number"
    .Range("B1").Value = "Element"
    .Range("C1").Value = "Type"
    .Range("D1").Value = "Value1"
End With
recRow = 2

With sourceWS
    lastRow = .Range("A1").End(xlDown).Row
   
    For i = 2 To lastRow
        destWS.Cells(recRow, 1).Resize(4, 1).Value = .Cells(i, 1).Value
       
        'Magic values, since you didn't tell me where they come from! :(
        destWS.Cells(recRow, 2).Value = "ABC"
        destWS.Cells(recRow + 1, 2).Value = "XYZ"
        destWS.Cells(recRow + 2, 2).Value = "ABC 12.5"
        destWS.Cells(recRow + 3, 2).Value = "XYZ 12.5"
       
        'More magic values
        destWS.Cells(recRow, 3).Value = "A1"
        destWS.Cells(recRow + 1, 3).Value = "X1"
        destWS.Cells(recRow + 2, 3).Value = "A1 12.5"
        destWS.Cells(recRow + 3, 3).Value = "X1 12.5"
       
        'Perform calculations
        destWS.Cells(recRow, 4) = .Cells(i, 3)
        destWS.Cells(recRow + 1, 4) = .Cells(i, 4)
        destWS.Cells(recRow + 2, 4) = .Cells(i, 3) * 0.125
        destWS.Cells(recRow + 3, 4) = .Cells(i, 4) * 0.125
       
        recRow = recRow + 4
    Next i
End With
Application.ScreenUpdating = True
End Sub

 

[Abhijeet]

Hi Luke M
This is work but not goes to the last cell if any data please give me goes to the last cell if any data

 

[Luke M]

Umm...yes it does. If I add more rows of data in Sheet1, then more output is generated. To what are you referring?

 

[Abhijeet]

If any blank cell between the data then not pull below bank data

 

[Luke M]

What do you want to happen with the blank rows? More importantly, why do you have blank rows in your data??
http://www.ozgrid.com/Excel/ExcelSpreadsheetDesign.htm#Layout