deplacer un onglet d'un classeur à un autre à partir d'une liste

[superbog]

Bonjour,

Je souhaite déplacer automatiquement des onglets d'un classeur (affaires.xlsm) à un autre (archives.xlsm) en fonction d'une liste

l'onglet client du classeur affaires.xlsm comprend cette liste, en colonne A le nom des dossiers (qui est aussi le nom des onglets à déplacer). Je souhaite déplacer les onglets lorsque la cellule O n'est pas vide et que et la cellule Q est vide

j'ai fait une macro mais elle ne fonctionne pas, pourriez vous m'aider

Sub archivage_automatique()
'
' archivage Macro
Dim dossier As String
   Dim i As Integer
 
Workbooks.Open "C:\Users\Brigitte\Dropbox\BB\xlbb\archives.xlsm"

   With Workbooks("affaires.xlsm").Sheets("clients")
    
'Recherche de la ligne et tri dans chaque feuille
For i = 2 To 400
    dossier = Cells(i, 1).Text
     
     'Copie les valeurs si colonne M = "A" et N vides
  If (.Cells(15)) = "A" And Not IsEmpty(.Cells(17)) Then
     Sheets(dossier).Select
     Sheets(dossier).Move Before:=Workbooks("archives.xlsm").Sheets(1)
         
                 Err = 0 'pour savoir si une erreur se produit
                
 
End If
Next i
    
    
    
  End With

MsgBox "archivage terminé"
End Sub

 

[Jacou]

Re : deplacer un onglet d'un classeur à un autre à partir d'une liste

Bonjour superbog,

j'ai déjà trouvé de petites omissions :

Sub archivage_automatique()
'
' archivage Macro
Dim dossier As Strin
Dim i As Integer
Workbooks.Open "C:\Users\Brigitte\Dropbox\BB\xlbb\archives.xlsm"
With Workbooks("affaires.xlsm").Sheets("clients")

'Recherche de la ligne et tri dans chaque feuille
For i = 2 To 400
dossier = .Cells(i, 1).Text

'Copie les valeurs si colonne O = "A" et Q vides
If (.Cells(i,15)) = "A" And Not IsEmpty(.Cells(i,17)) Then
.Sheets(dossier).Select
.Sheets(dossier).Move Before:=Workbooks("archives.xlsm").Sheets(1)

Err = 0 'pour savoir si une erreur se produit
End If
Next i

End With
MsgBox "archivage terminé"
End Sub

Essaie avec ces premières modifs.

Bonne journée

 

[superbog]

Re : deplacer un onglet d'un classeur à un autre à partir d'une liste

j'ai fait les modifs, sur la ligne

.Sheets(dossier).Select

j'ai le message "erreur d'exécution 438, propriété ou méthode non gérée par cet objet...

voici la macro entière

Sub archivage_automatique()

' archivage Macro
Dim dossier As String
Dim i As Integer
Workbooks.Open "C:\Users\Brigitte\Dropbox\BB\xlbb\archives.xlsm"
With Workbooks("affaires.xlsm").Sheets("clients")

'Recherche de la ligne et tri dans chaque feuille
For i = 2 To 400
dossier = .Cells(i, 1).Text

'Copie les valeurs si colonne O = "A" et Q vides
If (.Cells(i, 15)) = "A" And Not IsEmpty(.Cells(i, 17)) Then
.Sheets(dossier).Select
.Sheets(dossier).Move Before:=Workbooks("archives.xlsm").Sheets(1)

Err = 0 'pour savoir si une erreur se produit
End If
Next i

End With
MsgBox "archivage terminé"
End Sub

 

[Jacou]

Re : deplacer un onglet d'un classeur à un autre à partir d'une liste

Bonjour à tous,
il faut supprimer le point devant les deux instructions

.Sheets(dossier).Select
.Sheets(dossier).Move Before:=Workbooks("archives.xlsm").Sheets(1)

et le remplacer par

Workbooks("affaires.xlsm").

bonne journée

 

[superbog]

Re : deplacer un onglet d'un classeur à un autre à partir d'une liste

ca ne fonctionne toujours pas, erreur 1004 "la methode select de la classe worksheet a échoué"

Bonjour à tous,
il faut supprimer le point devant les deux instructions

et le remplacer par
bonne journée

 

[Jacou]

Re : deplacer un onglet d'un classeur à un autre à partir d'une liste

Bonsoir Superbog, bonsoir le forum,

il faut réactiver le classeur "affaires.xlsm" après avoir ouvert le classeur "archives.xlsm".
ton code deviendra donc :

Sub archivage_automatique()
'
' archivage Macro
Dim dossier As Strin
Dim i As Integer
Workbooks.Open "C:\Users\Brigitte\Dropbox\BB\xlbb\archives.xlsm"
With Workbooks("affaires.xlsm").Sheets("clients")

'Recherche de la ligne et tri dans chaque feuille
For i = 2 To 400
dossier = .Cells(i, 1).Text

'Copie la feuille dans le fichier archives si colonne O = "A" et Q vide
If (.Cells(i,15)) = "A" And IsEmpty(.Cells(i,17)) Then
Workbooks("affaires.xlsm").Sheets(dossier).Select
Workbooks("affaires.xlsm").Sheets(dossier).Move Before:=Workbooks("archives.xlsm").Sheets(1)

Err = 0 'pour savoir si une erreur se produit
End If
Next i

End With
MsgBox "archivage terminé"
End Sub

j'ai aussi remplacé la condition "Not IsEmpty" par "IsEmpty" pour respecter la règle que tu avais énoncée.

Bonne nuit