Select all sheets but (VBA)

P

percy83

Active Member
Joined
Mar 11, 2009
Messages
278
Select sheet question<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
<o:p> </o:p>
Hi All,<o:p></o:p>
<o:p> </o:p>
I am currently trying to put together a macro that will select multiple sheets and copy and paste values from one column to another. The macro has to work regardless of how many sheets there are in the workbook. <o:p></o:p>
<o:p> </o:p>
What I was thinking is that I can’t use the index no. since I don’t know how many sheets there are in that workbook. So what I want is to select all sheets but a number of fixed names.<o:p></o:p>
<o:p> </o:p>
How can I do this? I’ve tried following but I cant get it to work.<o:p></o:p>
<o:p> </o:p>
Code: 
Sub test()<o:p></o:p>
Application.ScreenUpdating = False<o:p></o:p>
For Each ws In ThisWorkbook.Worksheets<o:p></o:p>
    Select Case ws.Name<o:p></o:p>
        Case "Article and quantities", "summary"<o:p></o:p>
            ws.Select<o:p></o:p>
        Case Else<o:p></o:p>
            ws.Select False<o:p></o:p>
    End Select<o:p></o:p>
Next ws<o:p></o:p>
Sheets(1).Activate<o:p></o:p>
Range("A6").Select<o:p></o:p>
Application.ScreenUpdating = True<o:p></o:p>
End Sub
<o:p> </o:p>
Thanks for your help!<o:p></o:p>
<o:p> </o:p>
BR <o:p></o:p>
Per <o:p></o:p>
 
Sort by date Sort by votes
You can record a macro that part and add the line like

Code: 
With ActiveSheet
    .Columns("a").Cut .Range("c1")
    etc
End With

I need to go now...
 
Upvote 0

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Try

Code: 
Sub stuff()
Dim ws As Worksheet, nm As String
nm = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1)
For Each ws In Worksheets
    With ws
        If .Name <> "summary" And .Name <> "Article and quantities" Then
            .Columns("G:I").Insert
        End If
    End With
Next ws
ThisWorkbook.SaveAs Filename:=nm & "second pricing.xls"
End Sub
 
Upvote 0
Percy,

Off to bed for this lad, but please note that cross-posting w/o providing a link to the other site's thread is, well... not a way to get oodles of help.

Ken Puls has IMHO the nicest, clearest explanation of why, but in short, it wastes time for anyone answering to either and/or both have to check multi threads or waste time offereing similar suggestions.

I hope that makes sense,

http://vbaexpress.com/forum/showthread.php?t=27446

Mark
 
Upvote 0
GTO said:
Percy,

Off to bed for this lad, but please note that cross-posting w/o providing a link to the other site's thread is, well... not a way to get oodles of help.

Ken Puls has IMHO the nicest, clearest explanation of why, but in short, it wastes time for anyone answering to either and/or both have to check multi threads or waste time offereing similar suggestions.

I hope that makes sense,

http://vbaexpress.com/forum/showthread.php?t=27446

Mark
Click to expand...

Hello GTO,

I am really sorry for that. I should have known better!

If we break down my problem in a few different stages:

I want my macro to:

1: Select all sheets in a workbook except the sheets with the names "articles", "summary". I want this beacuse I need the macro to work regardless of how many sheets there are in the workbook. All of the workbooks that will be using this macro has the above mentioned sheetnames that should be excluded from this macro.

2: Do a multiple edit with all selected sheets that will include
  • Highlighting values in different ranges and moving those values four columns to the right. I dont want the original cell formatting to be lost.
3: Save a copy of this new file with what ever the origin file was named + "second pricing". Example origin file: test.xls new file: test second pricing.xls. I want the new filepath to be the same as the old one.

I hope this will give you a better picture of what I want to do.

Thank so very much for your help!!!

Percy
 
Upvote 0
percy83 said:
...Do a multiple edit with all selected sheets that will include
  • Highlighting values in different ranges and moving those values four columns to the right. I dont want the original cell formatting to be lost.
Click to expand...

A bit of guessing as to the "moving" part and where we're worried about keeping the formatting (source/destination/both).

Anyways, I certainly agree with Peter, that there's rarely reason to activate/select (highlight). In this case, as it appears you may not want to insert columns, but maybe copy/paste, the selecting everything part seems problematic, as at least as far as I know, we're not copying/pasting discontiguous ranges (multiple selections).

Certainly no guarantees, but try...

In a Standard Module:
<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> ex()<br><SPAN style="color:#00007F">Dim</SPAN> ws <SPAN style="color:#00007F">As</SPAN> Worksheet<br><SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> ws <SPAN style="color:#00007F">In</SPAN> ThisWorkbook.Worksheets<br>        <SPAN style="color:#00007F">With</SPAN> ws<br>            <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> .Name = "article" _<br>            And <SPAN style="color:#00007F">Not</SPAN> .Name = "summary" <SPAN style="color:#00007F">Then</SPAN><br>                <SPAN style="color:#007F00">'// Change upper number to include how far you wnat to go, as far as    //</SPAN><br>                <SPAN style="color:#007F00">'// "every seven columns".                                              //</SPAN><br>                <SPAN style="color:#00007F">For</SPAN> i = 7 <SPAN style="color:#00007F">To</SPAN> 28 <SPAN style="color:#00007F">Step</SPAN> 7<br>                    <SPAN style="color:#007F00">'// I guessed that you'd want to leave the formatting in the orig   //</SPAN><br>                    <SPAN style="color:#007F00">'// columns, so copied and clear contents.  Change to suit.         //</SPAN><br>                    .Columns(i).Copy .Columns(i + 3)<br>                    .Columns(i).ClearContents<br>                <SPAN style="color:#00007F">Next</SPAN><br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN><br>    <SPAN style="color:#007F00">'// Presumes pre 2007                                                               //</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> ThisWorkbook<br>        .SaveAs .Path & Application.PathSeparator & _<br>                Left(.Name, InStrRev(.Name, ".", , vbTextCompare) - 1) & _<br>                Chr(32) & "second pricing.xls"<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Does that look like the right direction to take?

Mark
 
Upvote 0
GTO said:
A bit of guessing as to the "moving" part and where we're worried about keeping the formatting (source/destination/both).

Anyways, I certainly agree with Peter, that there's rarely reason to activate/select (highlight). In this case, as it appears you may not want to insert columns, but maybe copy/paste, the selecting everything part seems problematic, as at least as far as I know, we're not copying/pasting discontiguous ranges (multiple selections).

Certainly no guarantees, but try...

In a Standard Module:
Option Explicit

Sub ex()
Dim ws As Worksheet
Dim i As Long

For Each ws In ThisWorkbook.Worksheets
With ws
If Not .Name = "article" _
And Not .Name = "summary" Then
'// Change upper number to include how far you wnat to go, as far as //
'// "every seven columns". //
For i = 7 To 28 Step 7
'// I guessed that you'd want to leave the formatting in the orig //
'// columns, so copied and clear contents. Change to suit. //
.Columns(i).Copy .Columns(i + 3)
.Columns(i).ClearContents
Next
End If
End With
Next
'// Presumes pre 2007 //
With ThisWorkbook
.SaveAs .Path & Application.PathSeparator & _
Left(.Name, InStrRev(.Name, ".", , vbTextCompare) - 1) & _
Chr(32) & "second pricing.xls"
End With
End Sub

Does that look like the right direction to take?

Mark
Click to expand...


I am afraid that is has to work for multiple selection...
 
Upvote 0
In lack of another good solution I made a macro with the built-in recorder.

This is what I've got. My problem now is that the actual copying and pasteing is made in the active sheet. Can please someone advise?

Code: 
Sub skarp()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
With ws
If Not .Name = "Article and quantities" _
And Not .Name = "SUMMARY" Then
Range("K7:K207").Select
    Selection.Copy
    
    Range("Q7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("U7:U207").Select
    
    Selection.Copy
    
    Range("AA7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("AE7:AE207").Select
    
    Selection.Copy
    
    Range("AK7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("AO7:AO207").Select
    
    Selection.Copy
    
    Range("AU7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("AY7:AY207").Select
    
    Selection.Copy
    
    Range("BE7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("BI7:BI207").Select
    
    Selection.Copy
    
    Range("BO7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("BS7:BS207").Select
    
    Selection.Copy
    
    Range("BY7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("CC7:CC207").Select
    
    Selection.Copy
    
    Range("CI7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
    Range("CM7:CM207").Select
    
    Selection.Copy
    
    Range("CS7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
    
    Range("CV7:CV207").Select
    
    Selection.Copy
    
    Range("DC7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        Range("DG7:DG207").Select
    
    Selection.Copy
    
    Range("DM7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
    Range("DQ7:DQ207").Select
    
    Selection.Copy
    
    Range("DW7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
        Range("EA7:EA207").Select
    
    Selection.Copy
    
    Range("EG7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
    Range("EK7:EK207").Select
    
    Selection.Copy
    
    Range("EQ7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
    Range("EU7:EU207").Select
    
    Selection.Copy
    
    Range("FA7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("FE7:FE207").Select
    
    Selection.Copy
    
    Range("FK7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
    Range("FO7:FO207").Select
    
    Selection.Copy
    
    Range("FU7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
    Range("FY7:FY207").Select
    
    Selection.Copy
    
    Range("GE7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("GI7:GI207").Select
    
    Selection.Copy
    
    Range("GO7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("GS7:GS207").Select
    
    Selection.Copy
    
    Range("GY7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("HC7:HC207").Select
    
    Selection.Copy
    
    Range("HI7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
    Range("HM7:HM207").Select
    
    Selection.Copy
    
    Range("HS7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("HW7:HW207").Select
    
    Selection.Copy
    
    Range("IC7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
End With
Next ws
End Sub
 
Upvote 0
Try

Code: 
Sub skarp()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    With ws
        If .Name <> "Article and quantities" And .Name <> "SUMMARY" Then
            .Range("K7:K207").Copy
            .Range("Q7").PasteSpecial Paste:=xlPasteValues
            .Range("U7:U207").Copy
            .Range("AA7").PasteSpecial Paste:=xlPasteValues
            .Range("AE7:AE207").Copy
            .Range("AK7").PasteSpecial Paste:=xlPasteValues
            .Range("AO7:AO207").Copy
            .Range("AU7").PasteSpecial Paste:=xlPasteValues
            .Range("AY7:AY207").Copy
            .Range("BE7").PasteSpecial Paste:=xlPasteValues
            .Range("BI7:BI207").Copy
            .Range("BO7").PasteSpecial Paste:=xlPasteValues
            .Range("BS7:BS207").Copy
            .Range("BY7").PasteSpecial Paste:=xlPasteValues
            .Range("CC7:CC207").Copy
            .Range("CI7").PasteSpecial Paste:=xlPasteValues
            .Range("CM7:CM207").Copy
            .Range("CS7").PasteSpecial Paste:=xlPasteValues
            .Range("CV7:CV207").Copy
            .Range("DC7").PasteSpecial Paste:=xlPasteValues
            .Range("DG7:DG207").Copy
            .Range("DM7").PasteSpecial Paste:=xlPasteValues
            .Range("DQ7:DQ207").Copy
            .Range("DW7").PasteSpecial Paste:=xlPasteValues
            .Range("EA7:EA207").Copy
            .Range("EG7").PasteSpecial Paste:=xlPasteValues
            .Range("EK7:EK207").Copy
            .Range("EQ7").PasteSpecial Paste:=xlPasteValues
            .Range("EU7:EU207").Copy
            .Range("FA7").PasteSpecial Paste:=xlPasteValues
            .Range("FE7:FE207").Copy
            .Range("FK7").PasteSpecial Paste:=xlPasteValues
            .Range("FO7:FO207").Copy
            .Range("FU7").PasteSpecial Paste:=xlPasteValues
            .Range("FY7:FY207").Copy
            .Range("GE7").PasteSpecial Paste:=xlPasteValues
            .Range("GI7:GI207").Copy
            .Range("GO7").PasteSpecial Paste:=xlPasteValues
            .Range("GS7:GS207").Copy
            .Range("GY7").PasteSpecial Paste:=xlPasteValues
            .Range("HC7:HC207").Copy
            .Range("HI7").PasteSpecial Paste:=xlPasteValues
            .Range("HM7:HM207").Copy
            .Range("HS7").PasteSpecial Paste:=xlPasteValues
            .Range("HW7:HW207").Copy
            .Range("IC7").PasteSpecial Paste:=xlPasteValues
        End If
    End With
Next ws
End Sub
 
Upvote 0
How come it only worked on the active sheet before you tweaked my code? I've added another function to change the column headers that also only work on the active sheet. (code in red).

Thanks for your precious help by the way!

Code: 
Sub skarp()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    With ws
        If .Name <> "Article and quantities" And .Name <> "SUMMARY" Then
'kopierar de gamla värdena över till rätt kolumn
            .Range("K7:K207").Copy
            .Range("Q7").PasteSpecial Paste:=xlPasteValues
            .Range("U7:U207").Copy
            .Range("AA7").PasteSpecial Paste:=xlPasteValues
            .Range("AE7:AE207").Copy
            .Range("AK7").PasteSpecial Paste:=xlPasteValues
            .Range("AO7:AO207").Copy
            .Range("AU7").PasteSpecial Paste:=xlPasteValues
            .Range("AY7:AY207").Copy
            .Range("BE7").PasteSpecial Paste:=xlPasteValues
            .Range("BI7:BI207").Copy
            .Range("BO7").PasteSpecial Paste:=xlPasteValues
            .Range("BS7:BS207").Copy
            .Range("BY7").PasteSpecial Paste:=xlPasteValues
            .Range("CC7:CC207").Copy
            .Range("CI7").PasteSpecial Paste:=xlPasteValues
            .Range("CM7:CM207").Copy
            .Range("CS7").PasteSpecial Paste:=xlPasteValues
            .Range("CV7:CV207").Copy
            .Range("DC7").PasteSpecial Paste:=xlPasteValues
            .Range("DG7:DG207").Copy
            .Range("DM7").PasteSpecial Paste:=xlPasteValues
            .Range("DQ7:DQ207").Copy
            .Range("DW7").PasteSpecial Paste:=xlPasteValues
            .Range("EA7:EA207").Copy
            .Range("EG7").PasteSpecial Paste:=xlPasteValues
            .Range("EK7:EK207").Copy
            .Range("EQ7").PasteSpecial Paste:=xlPasteValues
            .Range("EU7:EU207").Copy
            .Range("FA7").PasteSpecial Paste:=xlPasteValues
            .Range("FE7:FE207").Copy
            .Range("FK7").PasteSpecial Paste:=xlPasteValues
            .Range("FO7:FO207").Copy
            .Range("FU7").PasteSpecial Paste:=xlPasteValues
            .Range("FY7:FY207").Copy
            .Range("GE7").PasteSpecial Paste:=xlPasteValues
            .Range("GI7:GI207").Copy
            .Range("GO7").PasteSpecial Paste:=xlPasteValues
            .Range("GS7:GS207").Copy
            .Range("GY7").PasteSpecial Paste:=xlPasteValues
            .Range("HC7:HC207").Copy
            .Range("HI7").PasteSpecial Paste:=xlPasteValues
            .Range("HM7:HM207").Copy
            .Range("HS7").PasteSpecial Paste:=xlPasteValues
            .Range("HW7:HW207").Copy
            .Range("IC7").PasteSpecial Paste:=xlPasteValues
'rensar gamla celler
            .Range( _
        "J7:J207,T7:T207,AD7:AD207,AN7:AN207,AX7:AX207,BH7:BH207,BR7:BR207,CB7:CB207,CL7:CL207,CV7:CV207,DF7:DF207,DP7:DP207,DZ7:DZ207,EJ7:EJ207,ET7:ET207,FD7:FD207,FN7:FN207,FX7:FX207,GH7:GH207,GR7:GR207,HB7:HB207,HL7:HL207,HV7:HV207" _
        ).clearcontents
'ändrar rubriker på kolumner
        [COLOR=red]Cells.Replace What:="price last season (OBS EUR)", Replacement:= _[/COLOR]
[COLOR=red]       "Price first pricing", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _[/COLOR]
[COLOR=red]       False, SearchFormat:=False, ReplaceFormat:=False[/COLOR]
 
[COLOR=red]       Cells.Replace What:="Compared to price last season", Replacement:= _[/COLOR]
[COLOR=red]       "Compared to first pricing", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _[/COLOR]
[COLOR=red]       False, SearchFormat:=False, ReplaceFormat:=False[/COLOR]
        
        Application.CutCopyMode = False
        End If
    End With
Next ws
With ThisWorkbook
.SaveAs .Path & Application.PathSeparator & _
Left(.Name, InStrRev(.Name, ".", , vbTextCompare) - 1) & _
Chr(32) & "second pricing.xls"
End With
End Sub
 
Upvote 0
You need to qualify the sheet by adding a . before Cells

Rich (BB code): 
       .Cells.Replace What:="price last season (OBS EUR)", Replacement:= _
       "Price first pricing", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
       False, SearchFormat:=False, ReplaceFormat:=False
 
       .Cells.Replace What:="Compared to price last season", Replacement:= _
       "Compared to first pricing", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
       False, SearchFormat:=False, ReplaceFormat:=False
 
Upvote 0
You must log in or register to reply here.

Similar threads

rjplante
  • Question
VBA to extract users name from outlook
Replies
2
Views
1K
Jaffirahamed
J
R
  • Solved
Debugging slow execution
Replies
8
Views
284
mumps
mumps
S
  • Solved
Modify the code to save files in xlsx format
Replies
4
Views
117
sofas
S
Guitarde
  • Question
Select multiple sheets in VBA based on criterias
Replies
1
Views
244
Guitarde
Guitarde
E
  • Question
Select Sheet Name on a sheet to use in VBA
Replies
4
Views
93
Alex Blakenburg
A

Forum statistics

Threads
1,216,119
Messages
6,128,946
Members
449,480
Latest member
yesitisasport

Share this page

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