VBA Code

[vikas9385]

I have following type of data:--

SAP CODE

NAME

H.Q

01/01/2015

01/02/2015

01/03/2015

01/04/2015

01/05/2015

01/06/2015

01/07/2015

01/08/2015

01/09/2015

01/10/2015

01/11/2015

01/12/2015

01/13/2015

01/14/2015

01/15/2015

01/16/2015

01/17/2015

01/18/2015

01/19/2015

01/20/2015

01/21/2015

01/22/2015

01/23/2015

01/24/2015

01/25/2015

01/26/2015

01/27/2015

01/28/2015

01/29/2015

01/30/2015

01/31/2015

101

A

Abc

L

2

1

S

2

CFA MEETING

S

102

B

Def

1

1

1

S

2

1

1

1

1

1

S

2

103

C

abc

1

1

1

S

2

1

1

1

1

1

S

<tbody>
</tbody>

but I need above data in following form:

SAP CODE	NAME	H.Q	DATE	Status
101	A	Abc	01.01.2015	L
102	B	Def	01.01.2015	1
103	C	abc	01.01.2015	1
101	A	Abc	01.02.2015	2
102	B	Def	01.02.2015	1
103	C	abc	01.02.2015	1

<tbody>
</tbody>

Dates are in mm/dd/yyyy format


My reach:-

Sub Test()
    Dim ShNew As Worksheet
    Dim r, lr, lc As Long
    Dim c As Long
    Dim i As Long
    With ActiveSheet.Range("A1").CurrentRegion
        Set ShNew = Worksheets.Add
        i = 1
        .Rows(1).Resize(, 3).Copy ShNew.Range("A1")
        For c = 3 To .Columns.Count Step 1
            For r = 2 To .Rows.Count
                i = i + 1
                .Range("A" & r).Resize(, 3).Copy ShNew.Range("A" & i)
                .Cells(r, c).Resize(, 1).Copy ShNew.Range("D" & i)
            Next r
        Next c
    End With
    Sheets("Main").Select
     
    lr = WorksheetFunction.CountA(ActiveSheet.Range("a:a"))
    lc = WorksheetFunction.CountA(ActiveSheet.Range("1:1"))
    
    
    
    ShNew.Range("D1").Value = "Status"
    
    
    
    
    
End Sub

Please help

 

[RickXL]

Hi.

This should work. It is very similar to yours.

Sub Transpose()

    Dim iRow As Long, iCol As Long, outRow As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets.Add
    
    outRow = 2
    ws2.Range("A1:E1") = Array("SAP CODE", "NAME", "H.Q", "DATE", "Status")
    
    For iCol = 4 To ws1.Range("A1").CurrentRegion.Columns.Count
        For iRow = 2 To ws1.Range("A1").CurrentRegion.Rows.Count
            If ws1.Cells(iRow, iCol) <> "" Then
                ws2.Cells(outRow, 1).Resize(, 3) = ws1.Cells(iRow, 1).Resize(, 3).Value
                ws2.Cells(outRow, 4) = ws1.Cells(1, iCol)
                ws2.Cells(outRow, 5) = ws1.Cells(iRow, iCol)
                outRow = outRow + 1
            End If
        Next iRow
    Next iCol
    
    ws2.Columns(4).NumberFormat = "MM/DD/YYYY"
    ws2.Columns("A:E").AutoFit
    
End Sub

 

[vikas9385]

Thanx a lot... Rick XL

 

[RickXL]

No problem and thanks for the feedback.