VBA : Copy "Pivot like layout" to "data dump layout" data
Closed
stan-star
Posts
4
Registration date
Monday March 2, 2015
Status
Member
Last seen
March 3, 2015
-
Mar 2, 2015 at 04:40 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Mar 3, 2015 at 12:09 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Mar 3, 2015 at 12:09 PM
Related:
- VBA : Copy "Pivot like layout" to "data dump layout" data
- Vba case like - Guide
- Number to words in excel formula without vba - Guide
- Vba check if value is in array - Guide
- Vba color index - Guide
- How to open vba in excel - Guide
1 response
TrowaD
Posts
2921
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
December 27, 2022
555
Mar 3, 2015 at 12:09 PM
Mar 3, 2015 at 12:09 PM
Hi Stan-star,
In the code below the source sheet is called Sheet1.
The destination sheet is called Sheet2.
You can use Find & Replace (Ctrl+H) to change the sheet references to your own.
Make sure that Sheet2 has its header in place for the code to work properly.
Here is the code:
Best regards,
Trowa
In the code below the source sheet is called Sheet1.
The destination sheet is called Sheet2.
You can use Find & Replace (Ctrl+H) to change the sheet references to your own.
Make sure that Sheet2 has its header in place for the code to work properly.
Here is the code:
Sub RunMe()
Dim x, lRow As Integer
Sheets("Sheet1").Select
lRow = Range("A" & Rows.Count).End(xlUp).Row
For x = 2 To lRow Step 1
Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Range("A" & x)
Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Range("B1")
Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Range("B" & x)
Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Range("A" & x)
Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Range("C1")
Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Range("C" & x)
Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Range("A" & x)
Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Range("D1")
Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Range("D" & x)
Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Range("A" & x)
Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Range("E1")
Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Range("E" & x)
Next x
lRow = (lRow - 1) * 4 + 1
Sheets("Sheet2").Select
Range("A1").CurrentRegion.AutoFilter Field:=3, Criteria1:="0"
Range("A2:A" & lRow).EntireRow.Delete
Rows(1).AutoFilter
End Sub
Best regards,
Trowa
