Hi, I have a worksheet with 90 crosstabs, I'm trying to merge all of them into a consolidated flat table. Researching I found the attached code made by a member named Norie. The example was made for only one crosstab, so I made some changes to allow it to work for all sheets in a workbook. It worked fine, but I have a problem, my crosstabs have 3 row fields and the code was written for a crosstable with only one column field. I dont know how to fix it.
I'm attaching the original code, my modified code, the original crosstab and my crosstab.
Code
Sub OriginalCode()
Dim wsData As Worksheet
Dim wsNew As Worksheet
Dim rngSrc As Range
Dim rngDst As Range
Dim LastCol As Long
Dim LastRow As Long
Dim LastRowDst As Long
Dim I As Long
Set wsData = Worksheets("Sheet1")
Set wsNew = Worksheets.Add
LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
LastRowDst = 2
LastCol = wsData.Range("IV1").End(xlToLeft).Column
wsNew.Range("A1:C1") = Array("Resources", "Month", "Value")
For I = 2 To LastRow
Set rngSrc = wsData.Range("A" & I)
Set rngDst = wsNew.Range("A" & LastRowDst)
rngSrc.Copy rngDst.Resize(LastCol - 1)
rngSrc.Offset(-(I - 1), 1).Resize(, LastCol - 1).Copy
rngDst.Offset(0, 1).PasteSpecial Transpose:=True
rngSrc.Offset(, 1).Resize(, LastCol - 1).Copy
rngDst.Offset(0, 2).PasteSpecial Transpose:=True
LastRowDst = LastRowDst + (LastCol - 1)
Next I
End Sub
Sub MyCode()
Dim wsData As Worksheet
Dim wsNew As Worksheet
Dim rngSrc As Range
Dim rngDst As Range
Dim LastCol As Long
Dim LastRow As Long
Dim LastRowDst As Long
Dim I As Long
Dim x As Long
Dim OldLastRow As Long
Dim OldLastRowDest As Long
Set wsNew = Sheets("plantilla")
LastRowDst = 2
For x = 2 To Sheets.Count
Set wsData = Worksheets(x)
LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
LastRowDst = wsNew.Range("A" & Rows.Count).End(xlUp).Row
LastCol = wsData.Range("IV1").End(xlToLeft).Column
wsNew.Range("A1:C1") = Array("MainAccount", "Fecha", "Monto")
For I = 2 To LastRow
Set rngSrc = wsData.Range("A" & I)
Set rngDst = wsNew.Range("A" & LastRowDst)
rngSrc.Copy rngDst.Resize(LastCol - 1)
rngSrc.Offset(-(I - 1), 1).Resize(, LastCol - 1).Copy
rngDst.Offset(0, 1).PasteSpecial Transpose:=True
rngSrc.Offset(, 1).Resize(, LastCol - 1).Copy
rngDst.Offset(0, 2).PasteSpecial Transpose:=True
LastRowDst = LastRowDst + (LastCol - 1)
Next I
Next x
End Sub
Display More
Help is appreciated