[VBA] Probleme emplacement macro
bonjour à tous,
j'ai un probleme concernant une macro sous vba.
En fait, je ne sais pas bien à quel endroit l'enregistrer. Je m'explique:
cette macro enregistre les lignes sélectionnées d'une des 2 feuilles du classeur (la feuille active) ou des deux feuilles dans une autre version et les enregistre dans un nouveau classeur.
Le probleme c'est que quand je place cette macro dans l'objet Feuil1 (à gauche en haut) ca ne l'éxécute QUE pour la feuille 1, si je la place dans objet feuil2 ca ne l'éxécute QUE pour la feuille 2 et quand je la mets dans "this workbook", la ca ne me copie rien du tout et ca m'enregistre une nouvelle feuille vide, alors que des lignes sont sélectionnées.
J'ai un peu cherché et j'avoue que je ne comprends pas pourquoi ca fait ca.
Voici mon code :
Sub enregistrer()
Dim j As Integer
j = 1
Set NewSheet = Worksheets.Add
'boucle dans la feuille activée jusqu'a la derniere ligne
For i = 1 To ActiveSheet.Range("A2").End(xlDown).Row
'condition ligne colorée
'si colorée, on copie la ligne dans la nouvelle feuille a partir de la premiere ligne
If Rows(i).Interior.ColorIndex = 33 Then
Rows(i).Copy
NewSheet.Range("A" & j).PasteSpecial Paste:=xlValues
j = j + 1 'incrément de j
End If
Next i
NewSheet.Copy
Nomfichier = Application.GetSaveAsFilename(fileFilter:="Classeur Excel (*.xls), *.xls")
ActiveWorkbook.SaveAs Filename:=Nomfichier, FileFormat:=xlWorkbookNormal
NewSheet.Delete
End Sub
J'espere que vous pourrez m'aider.
Merci d'avance.
j'ai un probleme concernant une macro sous vba.
En fait, je ne sais pas bien à quel endroit l'enregistrer. Je m'explique:
cette macro enregistre les lignes sélectionnées d'une des 2 feuilles du classeur (la feuille active) ou des deux feuilles dans une autre version et les enregistre dans un nouveau classeur.
Le probleme c'est que quand je place cette macro dans l'objet Feuil1 (à gauche en haut) ca ne l'éxécute QUE pour la feuille 1, si je la place dans objet feuil2 ca ne l'éxécute QUE pour la feuille 2 et quand je la mets dans "this workbook", la ca ne me copie rien du tout et ca m'enregistre une nouvelle feuille vide, alors que des lignes sont sélectionnées.
J'ai un peu cherché et j'avoue que je ne comprends pas pourquoi ca fait ca.
Voici mon code :
Sub enregistrer()
Dim j As Integer
j = 1
Set NewSheet = Worksheets.Add
'boucle dans la feuille activée jusqu'a la derniere ligne
For i = 1 To ActiveSheet.Range("A2").End(xlDown).Row
'condition ligne colorée
'si colorée, on copie la ligne dans la nouvelle feuille a partir de la premiere ligne
If Rows(i).Interior.ColorIndex = 33 Then
Rows(i).Copy
NewSheet.Range("A" & j).PasteSpecial Paste:=xlValues
j = j + 1 'incrément de j
End If
Next i
NewSheet.Copy
Nomfichier = Application.GetSaveAsFilename(fileFilter:="Classeur Excel (*.xls), *.xls")
ActiveWorkbook.SaveAs Filename:=Nomfichier, FileFormat:=xlWorkbookNormal
NewSheet.Delete
End Sub
J'espere que vous pourrez m'aider.
Merci d'avance.
Configuration: Windows 2000 Internet Explorer 6.0 Excel 2003
3 réponses
-
Bonjour,
À placer dans un module :
Sub Enregistrer() Const Destination = "Destination" Const Maitre = "MonFichier.xls" Dim j As Integer, i As Integer, Feuille As String Dim NomFichier As String j = 1 Feuille = ActiveSheet.Name Worksheets.Add.Name = Destination Sheets(Feuille).Select 'boucle dans la feuille activée jusqu'a la derniere ligne For i = 0 To (ActiveSheet.Range("A1:A65536").End(xlDown).Row - 1) 'condition ligne colorée 'si colorée, on copie la ligne dans la nouvelle feuille ' a partir de la premiere ligne If ActiveCell.Offset(i, 0).Interior.ColorIndex = 33 Then ActiveCell.Offset(i, 0).EntireRow.Copy Sheets(Destination).Range("A" & j).PasteSpecial Paste:=xlValues j = j + 1 'incrément de j End If Next i Sheets(Destination).Copy NomFichier = Application.GetSaveAsFilename(fileFilter:="Classeur Excel (*.xls), *.xls") ActiveWorkbook.SaveAs Filename:=NomFichier, FileFormat:=xlWorkbookNormal ActiveWorkbook.Close Application.DisplayAlerts = False Sheets(Destination).Delete Application.DisplayAlerts = True End Sub '
Lupin -
Merci beaucoup Lupin pour ton aide précieuse (et rapide) bien que je ne comprenne toujours pas trop pourquoi cela ne marchait pas (j'ai oublié de préciser que j'avais également essayé de la placer dans un module sans succès!!)
Merci encore en tout cas
Fab -
re :
Quand j'ai du temps ... c'est un plaisirs que d'aider autrui, et oui je suis altruiste :-)
Pour te donner quelques idées sur le non-fonctionnement.
Sub enregistrer() Dim j As Integer j = 1 Set NewSheet = Worksheets.Add ' L'instruction [ Worksheets.Add ] a le même effet que ' de dire [ ThisNewSheets.Select ] For i = 1 To ActiveSheet.Range("A2").End(xlDown).Row ' Donc le [ ActiveSheet ] dans la boucle For pointe ' sur la nouvelle feuille et non sur la source If Rows(i).Interior.ColorIndex = 33 Then ' Je n'ai jamais utiliser cette syntaxe et de plus ' le compilateur me génère une erreur -> [ Rows(i).Interior.ColorIndex ] Rows(i).Copy NewSheet.Range("A" & j).PasteSpecial Paste:=xlValues j = j + 1 End If Next i NewSheet.Copy NomFichier = Application.GetSaveAsFilename(fileFilter:="Classeur Excel (*.xls), *.xls") ActiveWorkbook.SaveAs Filename:=NomFichier, FileFormat:=xlWorkbookNormal ' Lors d'une destruction par VBA il est souhaitable de désactiver ' les "popups" de validation. ' Application.DisplayAlerts = False NewSheet.Delete End Sub '
Cordialement
Lupin
