Looping through Worksheets_(excluding one)
 

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

Looping through Worksheets_(excluding one)
 

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

--
Rick (MVP - Excel)



"Aaron Bartee" <Aaron wrote in message
...
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

Looping through Worksheets_(excluding one)
 

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

Aaron Bartee wrote:

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

--

Dave Peterson

Looping through Worksheets_(excluding one)
 

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
--
If this helps, please remember to click yes.


"Aaron Bartee" wrote:

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

Looping through Worksheets_(excluding one)
 

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.

Dave Peterson wrote:

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

Aaron Bartee wrote:

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

--

Dave Peterson

--

Dave Peterson