I have source file like this:
And I need output file like this:
I found how to make Transpose, but I need way how to copy only lines with values taking names and drop SUM.
Sub TransposeInsertRows()
Dim xRg As Range
Dim i As Long, j As Long, k As Long
Dim x As Long, y As Long
Set xRg = Application.InputBox _
(Prompt:="Range Selection...", _
Title:="Range", Type:=8)
Application.ScreenUpdating = False
x = xRg(1, 1).Column + 1
y = xRg(1, xRg.Columns.Count).Column
For i = xRg(xRg.Rows.Count, 1).Row To xRg(1, 1).Row Step -1
If Cells(i, x) <> "" And Cells(i, x + 1) <> "" Then
k = Cells(i, x - 1).End(xlToRight).Column
If k > y Then k = y
For j = k To x + 1 Step -1
Cells(i + 1, 1).EntireRow.Insert
With Cells(i + 1, x - 1)
.Value = .Offset(-1, 0)
.Offset(0, 1) = .Offset(-1, 1)
.Offset(0, 1) = Cells(i, j)
End With
Cells(i, j).ClearContents
Next j
End If
Next i
Application.ScreenUpdating = True
End Sub
January | February | Marzec | |||||||||||||||||||||
uuid | Name | Last name | SUM | A | B | C | D | E | SUM | A | B | C | D | E | SUM | A | B | C | D | E | |||
1 | John | Doe | 709 | 709 | 0 | 450 | 200 | 250 | |||||||||||||||
2 | Jane | Doe | 1 120 | 500 | 620 | 400 | 400 | 0 |
And I need output file like this:
uuid | Name | Last name | Month | Type | Value |
1 | John | Doe | January | C | 709 |
2 | Jane | Doe | January | A | 500 |
2 | Jane | Doe | January | C | 620 |
2 | Jane | Doe | February | A | 400 |
1 | John | Doe | March | B | 200 |
1 | Jane | Doe | March | D | 250 |
I found how to make Transpose, but I need way how to copy only lines with values taking names and drop SUM.
Sub TransposeInsertRows()
Dim xRg As Range
Dim i As Long, j As Long, k As Long
Dim x As Long, y As Long
Set xRg = Application.InputBox _
(Prompt:="Range Selection...", _
Title:="Range", Type:=8)
Application.ScreenUpdating = False
x = xRg(1, 1).Column + 1
y = xRg(1, xRg.Columns.Count).Column
For i = xRg(xRg.Rows.Count, 1).Row To xRg(1, 1).Row Step -1
If Cells(i, x) <> "" And Cells(i, x + 1) <> "" Then
k = Cells(i, x - 1).End(xlToRight).Column
If k > y Then k = y
For j = k To x + 1 Step -1
Cells(i + 1, 1).EntireRow.Insert
With Cells(i + 1, x - 1)
.Value = .Offset(-1, 0)
.Offset(0, 1) = .Offset(-1, 1)
.Offset(0, 1) = Cells(i, j)
End With
Cells(i, j).ClearContents
Next j
End If
Next i
Application.ScreenUpdating = True
End Sub