Assembling Data of Many Sheets in one Summary Sheet

[Akash]

Hi Nick/Norman,

I tried to use the macro provided by you. Its giving me the output but
not in the way i wanted. Right Now what i am using is:

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function

Sub Test3()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "MergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("Summary").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "MergeSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "Summary"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
Last = LastCol(DestSh)

'This example copies everything, if you only want to copy
'values/formats look at the example below the first
example
sh.Range("d5:d168").Copy DestSh.Cells(1, Last + 1)

End If
Next

Application.Goto DestSh.Cells(1)

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


What the macro is doing is copying the values of respective cells and
pasting it into new sheet (Summary) in the same cell.

Sheet1 Sheet2 Sheet3 Sheet4
D10 D10 D10 D10
D12 D12 D12 D12
D14 D14 D14 D14
D20 D20 D20 D20
D22 D22 D22 D22
D24 D24 D24 D24
D30 D30 D30 D30
D32 D32 D32 D32
D48 D48 D48 D48
D50 D50 D50 D50
D52 D52 D52 D52
D54 D54 D54 D54
D70 D70 D70 D70
D87 D87 D87 D87
D102 D102 D102 D102
D118 D118 D118 D118
D137 D137 D137 D137
D141 D141 D141 D141
D145 D145 D145 D145
D162 D162 D162 D162
D164 D164 D164 D164
D166 D166 D166 D166
D168 D168 D168 D168


But i want the optuput in other format

Data of Sheet1 D10 D12 D14 D20 D22 D24
Data of Sheet2 D10 D12 D14 D20 D22 D24
Data of Sheet3 D10 D12 D14 D20 D22 D24
Data of Sheet4 D10 D12 D14 D20 D22 D24


How can i do it. Can you pls amend the above mentioned macro so that i
can get the result as per my requiremnet.

Thanks

Akash

 

[NickHK]

Transpose ?

NickHK

 

[Akash]

hi Nick,

I know the about the fuction Transpose. But the problem is the data is
is not comming in the way i wanted. I mean to say.

Data is comming in this way.

D10
D12
D14
D16

I want it
D10
D11
D12
D13

I dont want any black cell.

What should i do in this regards.

Akash

 

[NickHK]

This is nothing to do with the requirement you posted before - changing
column paste to row paste.

Also, you are using
sh.Range("d5:d168").Copy
so you should be getting your "new" requirements, assuming there are no
blank cells in your range.

NickHK