Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Best Event for a situation. 3

Status
Not open for further replies.

ItIsHardToProgram

Technical User
Mar 28, 2006
946
CA
Hey every one,

I have a quick easy question, I want to place in a event the following code

Code:
Dim iWorksheetCount as integer

iWorksheetCount = Worksheets.Count

If iWorksheetCount > 15 Then
Event
End if

Whats is this for?

Prety darn simple, I have income statements that I copy in a excel file already containing the same income statement, I have a macro that replaces the value of the old income statements with the new ones freshly copied. After it deletes the new income statements.

The reason I proceed like this is that I don't want to lose the links that my cells have to the income statements (old).

What do I want to do?

As soon as I copy the income statements from one workbook to another I want the macro to test if the workbook has new income statements, and if so automaticaly paste/delete the new data.

This is a relativly easy concept and I only want to know what is the good event for what im doing, or if theres a better way of doing it?

Thank you very much,

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.
 





What event are you trying to make happen.

Usually it's an Event that makes something happen.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Im not sure I get what your saying, then again I probably am not explaining myself correctly.

What I do is simple.

I go to a workbook, select 9 worksheets, paste them in another workbook.

I want that workbook to know I pasted those 9 worksheets and then run my macro.

HTH understanding,

Thanks skip

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.
 
Code:
EVENT
Dim iWorksheetCount as integer

iWorksheetCount = Worksheets.Count

If iWorksheetCount > 15 Then
[highlight]Event[/highlight]
End if
END EVENT

Scractch what is in the middle of my if and replace with COPY/PASTE/DELETE for better understanding.

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.
 
I ahve tried this without success

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim iworksheetcount As Integer

iworksheetcount = ActiveWorkbook.IWorksheets.Count
If ActiveWorkbook.Worksheets(iworksheetcount).Name = "Archer (2)" Then
    Application.DisplayAlerts = False
    
    Sheets("Conso (2)").Range("B6:AF43").Copy
    Sheets("Conso").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("Conso (2)").Range("B45:AF54").Copy
    Sheets("Conso").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste

    Sheets("conso (2)").Delete
    
    Sheets("VSG (2)").Range("B6:AF43").Copy
    Sheets("VSG").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("VSG (2)").Range("B45:AF54").Copy
    Sheets("VSG").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
  
    Sheets("VSG (2)").Delete
    
    Sheets("Atrium (2)").Range("B6:AF43").Copy
    Sheets("Atrium").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("Atrium (2)").Range("B45:AF54").Copy
    Sheets("Atrium").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
  
    Sheets("Atrium (2)").Delete
    
    Sheets("sag (2)").Range("B6:AF43").Copy
    Sheets("sag").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("sag (2)").Range("B45:AF54").Copy
    Sheets("sag").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
  
    Sheets("sag (2)").Delete
    
    Sheets("jonq (2)").Range("B6:AF43").Copy
    Sheets("jonq").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("jonq (2)").Range("B45:AF54").Copy
    Sheets("jonq").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
  
    Sheets("jonq (2)").Delete
    
    Sheets("cascades (2)").Range("B6:AF43").Copy
    Sheets("cascades").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("cascades (2)").Range("B45:AF54").Copy
    Sheets("cascades").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
  
    Sheets("cascades (2)").Delete
    
    Sheets("VRS (2)").Range("B6:AF43").Copy
    Sheets("VRS").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("VRS (2)").Range("B45:AF54").Copy
    Sheets("VRS").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
  
    Sheets("VRS (2)").Delete
    
    Sheets("Estrie (2)").Range("B6:AF43").Copy
    Sheets("Estrie").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("Estrie (2)").Range("B45:AF54").Copy
    Sheets("Estrie").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
  
    Sheets("Estrie (2)").Delete
    
    Sheets("Archer (2)").Range("B6:AF43").Copy
    Sheets("Archer").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("Archer (2)").Range("B45:AF54").Copy
    Sheets("Archer").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
  
    Sheets("Archer (2)").Delete
    
    Sheets("Corpo (2)").Range("B6:AF43").Copy
    Sheets("Corpo").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("Corpo (2)").Range("B45:AF54").Copy
    Sheets("Corpo").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
  
    Sheets("Corpo (2)").Delete

Application.DisplayAlerts = True
Else

End If

Thanks for your help

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.
 
How about something similar to the following in the target workbook's ThisWorkbook Code Module?
Code:
Private CurrentWorksheetCount As Integer

Private Sub Workbook_Open()
    CurrentWorksheetCount = ThisWorkbook.Worksheets.Count
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim CompareWorksheetCount As Integer
    CompareWorksheetCount = ThisWorkbook.Worksheets.Count
    If (CompareWorksheetCount <> CurrentWorksheetCount) Then
        MsgBox "We have " & CompareWorksheetCount & " worksheet(s) in our workbook now."
        CurrentWorksheetCount = CompareWorksheetCount
    End If
End Sub
 
That would be the Event im looking, let me add the proper code and ill see what happens.

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.
 
I have this working like I want, but at the end returns an error.

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim iworksheetcount As Integer

iworksheetcount = Worksheets.Count

If Worksheets(iworksheetcount).Name = "Archer (2)" And Worksheets(iworksheetcount - 9).Name = "Conso (2)" Then
    Application.DisplayAlerts = False
    
    Sheets("Conso (2)").Range("B6:AF43").Copy
    Sheets("Conso").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("Conso (2)").Range("B45:AF54").Copy
    Sheets("Conso").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
      
    Sheets("Conso (2)").Delete
    
    Sheets("Corpo (2)").Range("B6:AF43").Copy
    Sheets("Corpo").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("Corpo (2)").Range("B45:AF54").Copy
    Sheets("Corpo").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
      
    Sheets("Corpo (2)").Delete
    
    
    Sheets("VSG (2)").Range("B6:AF43").Copy
    Sheets("VSG").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("VSG (2)").Range("B45:AF54").Copy
    Sheets("VSG").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
      
    Sheets("VSG (2)").Delete
    
    
    Sheets("Atrium (2)").Range("B6:AF43").Copy
    Sheets("Atrium").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("Atrium (2)").Range("B45:AF54").Copy
    Sheets("Atrium").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
      
    Sheets("Atrium (2)").Delete
    
    
    Sheets("sag (2)").Range("B6:AF43").Copy
    Sheets("sag").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("sag (2)").Range("B45:AF54").Copy
    Sheets("sag").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
      
    Sheets("sag (2)").Delete
    
    
    Sheets("jonq (2)").Range("B6:AF43").Copy
    Sheets("jonq").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("jonq (2)").Range("B45:AF54").Copy
    Sheets("jonq").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
      
    Sheets("jonq (2)").Delete
    
     Sheets("Cascades (2)").Range("B6:AF43").Copy
    Sheets("Cascades").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("Cascades (2)").Range("B45:AF54").Copy
    Sheets("Cascades").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
      
    Sheets("Cascades (2)").Delete
    
    Sheets("VRS (2)").Range("B6:AF43").Copy
    Sheets("VRS").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("VRS (2)").Range("B45:AF54").Copy
    Sheets("VRS").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
      
    Sheets("VRS (2)").Delete
    
    
    Sheets("Estrie (2)").Range("B6:AF43").Copy
    Sheets("Estrie").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("Estrie (2)").Range("B45:AF54").Copy
    Sheets("Estrie").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
      
    Sheets("Estrie (2)").Delete
    
    Sheets("Archer (2)").Range("B6:AF43").Copy
    Sheets("Archer").Select
    Range("B6:AF43").Select
    ActiveSheet.Paste
    Sheets("Archer (2)").Range("B45:AF54").Copy
    Sheets("Archer").Select
    Range("B45:AF54").Select
    ActiveSheet.Paste
      
    Sheets("Archer (2)").Delete
    

Application.DisplayAlerts = True
End If

End Sub

At the end it says that the paste fails "ActiveSheet.Paste" after the first block of code...

but everything was pasted fine...

When i don't copy the sheets, the if dosnt trigger, so i dont understand, its like it loops back up at the end...

Any idea?

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.
 




HOLY MACKREL!

Do you realize that each time you SELECT a sheet, that your code runs??? It called recursive.

What's so magic about 15 worksheets?

The EVENT that you're looking for is...

YOU HIT A BUTTON that runs a procedure (not the WorksheetActavate routine!!!)


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
$blush$ well the thing is I want it to be automatic...

I added the argument AND ActiveSheet.Name = "Conso (2)" in my if....

You would suggest what if I want this to be automatic, no button push!

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.
 
BTW for the Fact that I select sheets in my code, Excel won't let me paste through a range without a selection.

would offsets work for this situation?

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.
 




"Excel won't let me paste through a range without a selection."

NOT TRUE!
Code:
sheet.range.copy Destination:=othersheet.cell



Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Using Select is only slightly less evil than using Goto. Try the following (untested) code:
Code:
Public Sub CopyAllWorksheets()
    Dim wsSource As Worksheet
    Dim rgSource As Range
    Dim rgTarget As Range
    Dim WSNM As Variant
    Dim WSNMS As Variant
    
    WNMS = Array("Conso", "Corpo", "VSG", "Atrium", "sag", "jonq", "Cascades", "VRS", "Estrie", "Archer")
    
    Application.DisplayAlerts = False
    For Each WSNM In WSNMS
        Set wsSource = ThisWorkbook.Worksheets(WSNM & " (2)")
        Set rgSource = wsSource.Range("B6:AF43,B45:AF54")
        Set rgTarget = ThisWorkbook.Worksheets(WSNM).Range("B6:AF43,B45:AF54")
        
        rgSource.Copy rgTarget
        
        wsSource.Delete
    Next WSNM
    Application.DisplayAlerts = True
    
End Sub

And also, don't execute your code for each SheetActivate event. See my example above and only execute when all "Trigger" sheets have been copied over.
 
Here's a version for anytime you copy a duplicate worksheet over to your master workbook:
Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim nmTarget As String
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    
    On Error Resume Next
    Set wsSource = Sh
    
    If (Not wsSource Is Nothing) Then
        If (wsSource.Name Like "* (#)") Then 'This worksheet has a twin
            nmTarget = Left(wsSource.Name, Len(wsSource.Name) - 4)
            
            Set wsTarget = ThisWorkbook.Worksheets(nmTarget)
            
            If (Not wsTarget Is Nothing) Then
                wsSource.Range("B6:AF43").Copy wsTarget.Range("B6:AF43")
                wsSource.Range("B45:AF54").Copy wsTarget.Range("B45:AF54")
                            
                Application.DisplayAlerts = False
                wsSource.Delete
                Application.DisplayAlerts = True
            End If
        End If
    End If
    
End Sub
 
Well my friend Skip, you were right once more, Now that Ive done everything like I wanted, I have a problem.

This is my code

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim isheetcount As Integer
Dim isheet As Integer
Dim nmTarget As String
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim Test1 As Integer
    


On Error Resume Next

Set wsSource = Sh

If (Not wsSource Is Nothing) Then
    While (wsSource.Name Like "* (#)")
    
    
    Application.DisplayAlerts = False
        
        Select Case wsSource.Name
        Case "Conso (2)"
            Sheets("Conso").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Conso (2)").Range("B6:AF43").Value
            Sheets("Conso").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Conso (2)").Range("B45:AF54").Value
            Sheets("Conso (2)").Delete
        Case "Corpo (2)"
            Sheets("Corpo").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Corpo (2)").Range("B6:AF43").Value
            Sheets("Corpo").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Corpo (2)").Range("B45:AF54").Value
            Sheets("Corpo (2)").Delete
    
        
        Case "Atrium (2)"
            Sheets("Atrium").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Atrium (2)").Range("B6:AF43").Value
            Sheets("Atrium").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Atrium (2)").Range("B45:AF54").Value
            Sheets("Atrium (2)").Delete
        
        Case "VSG (2)"
            Sheets("VSG").Range("B6:AF43").FormulaR1C1 = _
            Sheets("VSG (2)").Range("B6:AF43").Value
            Sheets("VSG").Range("B45:AF54").FormulaR1C1 = _
            Sheets("VSG (2)").Range("B45:AF54").Value
            Sheets("VSG (2)").Delete
        
        Case "Sag (2)"
            Sheets("sag").Range("B6:AF43").FormulaR1C1 = _
            Sheets("sag (2)").Range("B6:AF43").Value
            Sheets("sag").Range("B45:AF54").FormulaR1C1 = _
            Sheets("sag (2)").Range("B45:AF54").Value
            Sheets("sag (2)").Delete
            
        Case "VRS (2)"
            Sheets("VRS").Range("B6:AF43").FormulaR1C1 = _
            Sheets("VRS (2)").Range("B6:AF43").Value
            Sheets("VRS").Range("B45:AF54").FormulaR1C1 = _
            Sheets("VRS (2)").Range("B45:AF54").Value
            Sheets("VRS (2)").Delete
        
        Case "Cascades (2)"
            Sheets("Cascades").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Cascades (2)").Range("B6:AF43").Value
            Sheets("Cascades").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Cascades (2)").Range("B45:AF54").Value
            Sheets("Cascades (2)").Delete
        
        Case "Jonq (2)"
            Sheets("jonq").Range("B6:AF43").FormulaR1C1 = _
            Sheets("jonq (2)").Range("B6:AF43").Value
            Sheets("jonq").Range("B45:AF54").FormulaR1C1 = _
            Sheets("jonq (2)").Range("B45:AF54").Value
            Sheets("jonq (2)").Delete
            
        Case "Estrie (2)"
            Sheets("Estrie").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Estrie (2)").Range("B6:AF43").Value
            Sheets("Estrie").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Estrie (2)").Range("B45:AF54").Value
            Sheets("Estrie (2)").Delete
        
        Case "Archer (2)"
            Sheets("Archer").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Archer (2)").Range("B6:AF43").Value
            Sheets("Archer").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Archer (2)").Range("B45:AF54").Value
            Sheets("Archer (2)").Delete
            
        Case "Comparable (2)"
            Sheets("Comparable").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Comparable (2)").Range("B6:AF43").Value
            Sheets("Comparable").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Comparable (2)").Range("B45:AF54").Value
            Sheets("Comparable (2)").Delete
            
        End Select
        
     
    Wend
    
    Application.DisplayAlerts = True
    
End If
End Sub

What is my problem? quite simple, and you already know the answer to that.

Considering my code is in SheetActive, as soon as I delete the sheets it reactivates another sheet, hence reruns my code and ends the present procedure (if I loop).

How would I bypass that, I could think of adding a True/false to a number of boolean, so that when i get out of the loop I delete after, would that be best?

Thanks for your help skip.



"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.
 
Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)

    Application.EnableEvents = False
    
    ' Your code
    
    Application.EnableEvents = True
    
End Sub
 
Still no joy

Code:
Public Function DoesWorkSheetExist(WorkSheetName As String, Optional WorkBookName As String)
     
    Dim WS As Worksheet
     
    On Error Resume Next
    If WorkBookName = vbNullString Then
        Set WS = Sheets(WorkSheetName)
    Else
        Set WS = Workbooks(WorkBookName).Sheets(WorkSheetName)
    End If
    On Error GoTo 0
     
    DoesWorkSheetExist = Not WS Is Nothing
     
End Function



Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim isheetcount As Integer
Dim isheet As Integer
Dim nmTarget As String
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim Test1 As Integer

Application.EnableEvents = False
    


On Error Resume Next

Set wsSource = Sh
isheetcount = Sheets.Count
If (Not wsSource Is Nothing) Then
    For isheet = 1 To isheetcount
        If (Sheets(isheet).Name Like "* (#)") Then
    
    
    Application.DisplayAlerts = False
        
        Select Case wsSource.Name
        Case "Conso (2)"
            Sheets("Conso").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Conso (2)").Range("B6:AF43").Value
            Sheets("Conso").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Conso (2)").Range("B45:AF54").Value
            Sheets("Conso (2)").Delete
        Case "Corpo (2)"
            Sheets("Corpo").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Corpo (2)").Range("B6:AF43").Value
            Sheets("Corpo").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Corpo (2)").Range("B45:AF54").Value
            Sheets("Corpo (2)").Delete
    
        
        Case "Atrium (2)"
            Sheets("Atrium").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Atrium (2)").Range("B6:AF43").Value
            Sheets("Atrium").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Atrium (2)").Range("B45:AF54").Value
            Sheets("Atrium (2)").Delete
            
        
        Case "VSG (2)"
            Sheets("VSG").Range("B6:AF43").FormulaR1C1 = _
            Sheets("VSG (2)").Range("B6:AF43").Value
            Sheets("VSG").Range("B45:AF54").FormulaR1C1 = _
            Sheets("VSG (2)").Range("B45:AF54").Value
            Sheets("VSG (2)").Delete
            
        Case "Sag (2)"
            Sheets("sag").Range("B6:AF43").FormulaR1C1 = _
            Sheets("sag (2)").Range("B6:AF43").Value
            Sheets("sag").Range("B45:AF54").FormulaR1C1 = _
            Sheets("sag (2)").Range("B45:AF54").Value
            Sheets("Sag (2)").Delete
            
        Case "VRS (2)"
            Sheets("VRS").Range("B6:AF43").FormulaR1C1 = _
            Sheets("VRS (2)").Range("B6:AF43").Value
            Sheets("VRS").Range("B45:AF54").FormulaR1C1 = _
            Sheets("VRS (2)").Range("B45:AF54").Value
            Sheets("VRS (2)").Delete
        
        Case "Cascades (2)"
            Sheets("Cascades").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Cascades (2)").Range("B6:AF43").Value
            Sheets("Cascades").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Cascades (2)").Range("B45:AF54").Value
            Sheets("Cascades (2)").Delete
        
        Case "Jonq (2)"
            Sheets("jonq").Range("B6:AF43").FormulaR1C1 = _
            Sheets("jonq (2)").Range("B6:AF43").Value
            Sheets("jonq").Range("B45:AF54").FormulaR1C1 = _
            Sheets("jonq (2)").Range("B45:AF54").Value
            Sheets("Jonq (2)").Delete
            
        Case "Estrie (2)"
            Sheets("Estrie").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Estrie (2)").Range("B6:AF43").Value
            Sheets("Estrie").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Estrie (2)").Range("B45:AF54").Value
            Sheets("Estrie (2)").Delete
        
        Case "Archer (2)"
            Sheets("Archer").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Archer (2)").Range("B6:AF43").Value
            Sheets("Archer").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Archer (2)").Range("B45:AF54").Value
            Sheets("Archer (2)").Delete
            
        Case "Comparable (2)"
            Sheets("Comparable").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Comparable (2)").Range("B6:AF43").Value
            Sheets("Comparable").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Comparable (2)").Range("B45:AF54").Value
            Sheets("Comparable (2)").Delete
            
        End Select
    End If
        
     
    Next isheet
    
    Application.DisplayAlerts = True
    
End If
    
    Application.EnableEvents = True
    
End Sub


Only 1 sheet deletes as before.

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.
 
I changed the Select Case because it was wrong, but strangely it deletes about 3 or 4 sheets at the time, it does not delete the whole thing...

why would that be?

Thx for your help so far,

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.
 
This works but I end up in a endless loop

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim isheetcount As Integer
Dim isheet As Integer
Dim nmTarget As String
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim Test1 As Integer

Application.EnableEvents = False
    


On Error Resume Next

Set wsSource = Sh
isheetcount = Sheets.Count
If (Not wsSource Is Nothing) Then
    For isheet = 1 To isheetcount
        While (Sheets(isheet).Name Like "* (#)")
    
    Application.DisplayAlerts = False
        
        Select Case Sheets(isheet).Name
        Case "Conso (2)"
            Sheets("Conso").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Conso (2)").Range("B6:AF43").Value
            Sheets("Conso").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Conso (2)").Range("B45:AF54").Value
            Sheets("Conso (2)").Delete
        Case "Corpo (2)"
            Sheets("Corpo").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Corpo (2)").Range("B6:AF43").Value
            Sheets("Corpo").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Corpo (2)").Range("B45:AF54").Value
            Sheets("Corpo (2)").Delete
    
        
        Case "Atrium (2)"
            Sheets("Atrium").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Atrium (2)").Range("B6:AF43").Value
            Sheets("Atrium").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Atrium (2)").Range("B45:AF54").Value
            Sheets("Atrium (2)").Delete
            
        
        Case "VSG (2)"
            Sheets("VSG").Range("B6:AF43").FormulaR1C1 = _
            Sheets("VSG (2)").Range("B6:AF43").Value
            Sheets("VSG").Range("B45:AF54").FormulaR1C1 = _
            Sheets("VSG (2)").Range("B45:AF54").Value
            Sheets("VSG (2)").Delete
            
        Case "Sag (2)"
            Sheets("sag").Range("B6:AF43").FormulaR1C1 = _
            Sheets("sag (2)").Range("B6:AF43").Value
            Sheets("sag").Range("B45:AF54").FormulaR1C1 = _
            Sheets("sag (2)").Range("B45:AF54").Value
            Sheets("Sag (2)").Delete
            
        Case "VRS (2)"
            Sheets("VRS").Range("B6:AF43").FormulaR1C1 = _
            Sheets("VRS (2)").Range("B6:AF43").Value
            Sheets("VRS").Range("B45:AF54").FormulaR1C1 = _
            Sheets("VRS (2)").Range("B45:AF54").Value
            Sheets("VRS (2)").Delete
        
        Case "Cascades (2)"
            Sheets("Cascades").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Cascades (2)").Range("B6:AF43").Value
            Sheets("Cascades").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Cascades (2)").Range("B45:AF54").Value
            Sheets("Cascades (2)").Delete
        
        Case "Jonq (2)"
            Sheets("jonq").Range("B6:AF43").FormulaR1C1 = _
            Sheets("jonq (2)").Range("B6:AF43").Value
            Sheets("jonq").Range("B45:AF54").FormulaR1C1 = _
            Sheets("jonq (2)").Range("B45:AF54").Value
            Sheets("Jonq (2)").Delete
            
        Case "Estrie (2)"
            Sheets("Estrie").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Estrie (2)").Range("B6:AF43").Value
            Sheets("Estrie").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Estrie (2)").Range("B45:AF54").Value
            Sheets("Estrie (2)").Delete
        
        Case "Archer (2)"
            Sheets("Archer").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Archer (2)").Range("B6:AF43").Value
            Sheets("Archer").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Archer (2)").Range("B45:AF54").Value
            Sheets("Archer (2)").Delete
            
        Case "Comparable (2)"
            Sheets("Comparable").Range("B6:AF43").FormulaR1C1 = _
            Sheets("Comparable (2)").Range("B6:AF43").Value
            Sheets("Comparable").Range("B45:AF54").FormulaR1C1 = _
            Sheets("Comparable (2)").Range("B45:AF54").Value
            Sheets("Comparable (2)").Delete
            
        Case Else
            Application.DisplayAlerts = True
            Application.EnableEvents = True
            Exit Sub
        End Select
        
    Wend
        
     
    Next isheet
    
    Application.DisplayAlerts = True
    
End If
    

Application.EnableEvents = True
    
End Sub

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.
 
Whoa... all that stuff about SheetActivate events and WorkbookActivate and recursive events and whatnot...

Have you tried using a _NewSheet() event as your trigger? As I recall, that does run when you paste a sheet. Sure, then it'll run seven times. Just use a nifty little Mid() call to copy from the new sheet to the sheet with the same name without the " (2)", then delete the new worksheet. The new worksheet itself is passed as a whole object argument (ByVal Sh As Object), so there should be no problem twiddling around with its name. This way you could also more easily adapt to *new* sheets, if that ever happens.

Sorry if this was no help at all, but I do hope it is.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top