Copying from multiple worksheets

[singcbl]

I have a workbook containing the following worksheets, "Summary", "INF", "HTL", "SWM" and "NPD".

These worksheet are the exactly the same layout, that is From A1 to R7 is the Header portion and the data from A8 downwards. What I want to accomplice is to copy from the other worksheets in this workbook to the "Summary" worksheet in the same workbook.

 

[ravishankar]

Hi
Paste the following codes in the macro window ( Alt F11)

d=8
for a = 2 to 5
for b = 8 to x
for c = 1 to 18
worksheets("summary").cells(d,c) = worksheets(a).cells(b,c)
next c
d= d+1
next b
d= d+1
next a

run the macro
Ravi

 

[singcbl]

Hi,

I created a macro in a module but when I run this macro nothing seem to happen

 

[ravishankar]

Hi
Try the following codes

Sub collate()
d = 8
For a = 2 To sheets.count
x = Worksheets(a).Cells(Rows.Count, 1).End(xlUp).Row
For b = 8 To x
For c = 1 To 18
Worksheets("summary").Cells(d, c) = Worksheets(a).Cells(b, c)
Next c
d = d + 1
Next b
d = d + 1
Next a
End Sub

run the macro
Ravi

 

[singcbl]

Ravi,

Your codes seems to work to a certain extent. But one thing though is certain of the cells loss the text colour and background colour. Is there a way around this?

 

[ravishankar]

Hi
add these two lines of code to the macro just before "next C".

Worksheets("summary").Cells(d, c).font.colorindex = Worksheets(a).Cells(b, c).font.colorindex
Worksheets("summary").Cells(d, c).interior.colorindex  = Worksheets(a).Cells(b, c).interior.colorindex

and run the macro
ravi

 

[singcbl]

Ravi,

Good work! The code is working as desired.

Thanks

 

[jindon]

Why so many loops in the cell???

Sub test()
Dim ws As Worksheet
For Each ws In Worksheets
     If ws.Name <> "summary" Then
          ws.Range("a8", ws.Range("a" & Rows.Count).end(xlUp)).Resize(,18).Copy
          With Sheets("summary").Range("a" & Rows.Count).End(xlUp).Offset(1)
               .PasteSpecial xlPasteValues
               .PasteSpecial xlPasteFormats
          End With
     End If
Next
End Sub