Loop Error When Only One Workbook Sheet

RG FL

New Member
Joined
Mar 1, 2007
Messages
37
How can I update the code below so that it doesn't errors out when the workbook contains only one sheet. Some workbooks contain many sheets others contain only one sheet


Sub Test ()
Dim ws As Worksheet
For Each ws In Worksheets
ws.UsedRange.Copy
ws.Range("A1").PasteSpecial Paste:=xlPasteValues
Next ws
Application.CutCopyMode = False
.Save
.Close True

Sub test
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
I don't think your problem is the number of worksheets. You don't have a With/End With construct, yet you're using a contracted scope-resolution syntax.

Code:
Sub Test ()
  Dim ws As Worksheet
  For Each ws In Worksheets
    ws.UsedRange.Copy
    ws.Range("A1").PasteSpecial Paste:=xlPasteValues
  Next ws
  Application.CutCopyMode = False
  ActiveWorkbook.Save
  ActiveWorkbook.Close True
End Sub
If that doesn't do it, post the actual error.
 
Upvote 0
Maybe put in a test to see if there is only one sheet? Something like this:
Code:
Select Case Sheets.Count
   Case 1
       'Put your routine in here, but limit to the one sheet
    Case Else
       'Put your routine for every sheet here
End Select
 
Upvote 0
Or

Code:
Sub test()
Dim ws As Worksheet

For Each ws In Worksheets
    ws.UsedRange.Value = ws.UsedRange.Value
Next ws

With ThisWorkbook
    .Save
    .Close True
End With

End Sub

VBA Noob
 
Upvote 0
Below is the whole code. I'm getting error: 1004 Paste Special Method of range class failed.

====================================

Code:
Sub ConvertToValuesCommunications()

'This code changes the pivot tables to values.

Application.DisplayAlerts = False

Dim fso As Object, myDir As String, myFolder As Object, myFile As Object

Set fso = CreateObject("Scripting.FileSystemObject")

myDir = "S:\Sales Operations\Expenses_Communication_Expenses\02.__Values_Communication_Expenses"

Application.EnableCancelKey = xlDisabled

For Each myFolder In fso.GetFolder(myDir).SubFolders
    For Each myFile In myFolder.Files
        If myFile.Name Like "*.xls" Then
            With Workbooks.Open(myDir & "\" & myFolder.Name & "\" & myFile.Name)
             
                Dim ws As Worksheet
                For Each ws In Worksheets
                ws.UsedRange.Copy
                ws.Range("A1").PasteSpecial Paste:=xlPasteValues
                Next ws
                Application.CutCopyMode = False
                .Save
                .Close True
               
            End With
        End If
    Next
Next
Set fso = Nothing

Application.DisplayAlerts = True
End Sub
 
Last edited by a moderator:
Upvote 0
The code is working now. The issue was that the pivot table must start on A1 for the code to work.
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top