Looping through Worksheets_(excluding one)

A

Aaron Bartee

I am trying to loop through every worksheet and select and copy a range of
dates (varrying lenghts) and paste in the first worksheet ('Usage Upload').
this is the code I have now but i cannot get the Select Case expression to
work.

Please help!


Sub Dates_Try()

Application.ScreenUpdating = False


Dim WS_Count As Integer
Dim I As Integer

WS_Count = ActiveWorkbook.Worksheets.Count

Select Case UCase(Worksheet.Name)

Case "Usage Upload"

Case Else


For I = 1 To WS_Count


Worksheets(I).Activate

'Range("A7").End(xlDown).End(xlRight).Select
Range("A7:B7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Usage Upload").Select
Range("E65536").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste

I = 1 + 1


Next I

End Select


End Sub
 
R

Rick Rothstein

You need your loop to do the checking, and exclusion, not a Case statement
containing the loop. Assuming your code does what you want, try structuring
it this way and see if it works for you...

Sub Dates_Try()
Dim WS_Count As Integer
Dim I As Integer
Application.ScreenUpdating = False
For I = 1 To WS_Count
If Worksheets(I).Name <> "Usage Upload" Then
Worksheets(I).Activate
'Range("A7").End(xlDown).End(xlRight).Select
Range("A7:B7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Usage Upload").Select
Range("E65536").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
I = 1 + 1
End If
Next I
End Sub
 
D

Dave Peterson

I'd use something like:

Option Explicit
Sub Dates_Try()

Dim WS_Count As Long
Dim iCtr As Long
Dim LastRow As Long
Dim RngToCopy As Range
Dim DestCell As Range

WS_Count = ActiveWorkbook.Worksheets.Count

For iCtr = 1 To WS_Count
Select Case UCase(Worksheets(iCtr).Name)
'if you're comparing to ucase, make sure
'you enter the value in upper case
Case Is = "USAGE UPLOAD"
'do nothing
Case Else
With Worksheets(iCtr)
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set RngToCopy = .Range("a7:B" & LastRow)
End With

With Worksheets("Usage Upload")
Set DestCell _
= .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0)
End With

RngToCopy.Copy _
DestCell
End Select
Next iCtr

End Sub
 
P

Paul C

It looks like your loop is in the wrong place to start with. You are
resetting your I value during the loop, which can cause issues. You also do
not need the UCase statement.

It looks like you are trying to copy data from every sheet into the Usage
Upload Sheet.

if so then I think it should look like this

Sub Dates_Try()

Application.ScreenUpdating = False

Dim WS_Count As Integer
Dim I As Integer

WS_Count = ActiveWorkbook.Worksheets.Count

For I = 1 To WS_Count

Select Case Sheets(I).Name

Case "Usage Upload"

Case Else

Worksheets(I).Activate
Range("A7:B7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Usage Upload").Select
Range("E65536").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
End Select

Next I


End Sub
 
D

Dave Peterson

Just a small change:

I'd really use:

RngToCopy.Copy _
Destination:=DestCell

Instead of:

RngToCopy.Copy _
DestCell

I think it's more self-documenting.

There's no difference in functionality, though.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top