Copy data from multiple sheets into one sheet

[aamirsq]

Hi,


I searched the net and this forum but found not solution. I want the below code to look in each Jan13, Feb13 & Mar13 and put all data in one column under sheet1 from C17. But this code this only working for the last sheet (i.e Mar13)??


Sub Copy_Sheets()

Dim ws As Worksheet

Application.ScreenUpdating = False

For Each ws In Sheets(Array("Jan13", "Feb13", "Mar13"))

With ws

.Range("B3:B60").Copy

Worksheets("Sheet2").Range("C" & Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial (xlPasteValues)

End With

Next ws

Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub

 

[DaveTurton]

Try:

[pre]

Sub Copy_Sheets()
Dim Copy_Range As Range
Dim ws As Worksheet

On Error Resume Next
Set Copy_Range = Range("B3:B60")

For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "Jan13", "Feb13", "Mar13"
ws.Range(Copy_Range.Address).Copy Destination:= _
Sheets("Sheet2").Range("C65536").End(xlUp)
End Select
Next ws
Set Copy_Range = Nothing
End Sub

[/pre]

 

[aamirsq]

its removing my heading on sheet2 & when i run again it repeats the duplicates the results

 

[DaveTurton]

This will keep your headers on Sheet2

[pre]

Sub Copy_Sheets()
Dim Copy_Range As Range
Dim ws As Worksheet

On Error Resume Next
Set Copy_Range = Range("B3:B60")

For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "Jan13", "Feb13", "Mar13"
ws.Range(Copy_Range.Address).Copy Destination:= _
Sheets("Sheet2").Range("C65536").End(xlUp).Offset(1,0)
End Select
Next ws
Set Copy_Range = Nothing
End Sub

[/pre]

 

[aamirsq]

I uploaded a sample file.


1. Still there is there if i keep try to click more than once it duplicates the results, i try to solve it but its not working.


2. I want the results under in "c" column sorted


http://www.fileconvoy.com/dfl.php?id=ge19dcbc4453d69c3999286445ca7960dcbd44d80e


Sub Copy_Sheets()

Dim Copy_Range As Range

Dim ws As Worksheet


Sheets("Sheet2").Range("B17:B4000").ClearContents

On Error Resume Next

Set Copy_Range = Range("B3:B60")


For Each ws In ActiveWorkbook.Worksheets

Select Case ws.Name

Case "Jan13", "Feb13", "Mar13", "Apr13", "May13", "Jun13"

ws.Range(Copy_Range.Address).Copy Destination:= _

Sheets("Sheet2").Range("C65536").End(xlUp).Offset(1, 0)

End Select

Next ws

Set Copy_Range = Nothing

End Sub


Thanks

 

[DaveTurton]

Why are your clearing contents in column B, would you not want to clear column C?

 

[aamirsq]

Its C, i mistakenly write here B...


Sheets("Sheet2").Range("C17:C4000").ClearContents


btw its also including zero values..