J'ai dans un classeur, besoin de copier certains onglets qui ne sont pas
toujours les mêmes, cette copie doit se faire sans les formules (càd collage
spécial uniquement valeurs),dans un nouveau classeur.
De quelle manière peut-on créer une macro qui me demanderait de choisir les
feuilles à copier (genre userform).
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Ange Ounis
Ce code, adaptation d'un code déjà diffusé, devrait répondre à ta demande une fois affecté à un bouton de barre d'outils :
''''''''''''''''''''''''''' 'construit une boite de dialogue temporaire pour sélectionner 'les feuilles que l'on souhaite copier dans un nouveau classeur
Sub ChoixFeuilles() 'd'après un code diffusé par René Roy, mpfe, disponible à cette adresse : 'http://frederic.sigonneau.free.fr/code/Impr/BoiteDialogueImprimerFeuilles.txt
Dim i As Integer, Arr(), x& Dim TopPos As Integer Dim SheetCount As Integer Dim PrintDlg As DialogSheet Dim CurrentSheet As Worksheet Dim cb As CheckBox
Application.ScreenUpdating = False
If Sheets.Count > 40 Then MsgBox "Trop de feuilles pour la boite de dialogue..." Exit Sub End If
' Ajoute une feuille de dialogue temporaire If ActiveWindow.SelectedSheets.Count > 1 Then Sheets(1).Activate Set PrintDlg = ActiveWorkbook.DialogSheets.Add PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option TopPos = 40 For i = 1 To ActiveWorkbook.Worksheets.Count Set CurrentSheet = ActiveWorkbook.Worksheets(i) ' Ne tient pas compte des feuilles vide ou masquées If Application.CountA(CurrentSheet.Cells) <> 0 And _ CurrentSheet.Visible Then SheetCount = SheetCount + 1 PrintDlg.CheckBoxes.Add 78, TopPos, 120, 16.5 PrintDlg.CheckBoxes(SheetCount).Text = CurrentSheet.Name TopPos = TopPos + 13 End If Next i
' Positionne les boutons OK et Annuler PrintDlg.Buttons.Left = 200
' Dimensionne la hauteur, la largeur et le titre de la bte de dialogue With PrintDlg.DialogFrame .Height = Application.Max _ (68, PrintDlg.DialogFrame.Top + TopPos - 34) .Width = 200 .Caption = "Feuille(s) à copier ? " End With
' Change l'ordre de tabulation des boutons OK et Annuler ' afin de donner le focus au premier bouton d'option PrintDlg.Buttons("Button 2").BringToFront PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue Application.ScreenUpdating = True If SheetCount <> 0 Then If PrintDlg.Show = True Then x = -1 Application.ScreenUpdating = False For i = 1 To SheetCount If PrintDlg.CheckBoxes(i).Value = xlOn Then x = x + 1: ReDim Preserve Arr(x) Arr(x) = PrintDlg.CheckBoxes(i).Caption End If Next i Else: Exit Sub End If Else MsgBox "Toutes les feuilles sont vides." End If
' Supprime la feuille de dialogue temporaire (sans message d'avertissement) Application.DisplayAlerts = False PrintDlg.Delete If x = -1 Then Exit Sub
' Sélectionne les feuilles et les copie dans un nouveau classeur Sheets(Arr).Copy
' Elimine les formules et ne conserve que les valeurs With ActiveWorkbook For i = 1 To .Sheets.Count .Sheets(i).UsedRange.Value = .Sheets(i).UsedRange.Value Next i End With
End Sub '''''''''''''''''''''''''''
---------- Ange Ounis ----------
Bonjour et bonne année à tous,
J'ai dans un classeur, besoin de copier certains onglets qui ne sont pas toujours les mêmes, cette copie doit se faire sans les formules (càd collage spécial uniquement valeurs),dans un nouveau classeur. De quelle manière peut-on créer une macro qui me demanderait de choisir les feuilles à copier (genre userform).
Ce code, adaptation d'un code déjà diffusé, devrait répondre à ta demande une
fois affecté à un bouton de barre d'outils :
'''''''''''''''''''''''''''
'construit une boite de dialogue temporaire pour sélectionner
'les feuilles que l'on souhaite copier dans un nouveau classeur
Sub ChoixFeuilles()
'd'après un code diffusé par René Roy, mpfe, disponible à cette adresse :
'http://frederic.sigonneau.free.fr/code/Impr/BoiteDialogueImprimerFeuilles.txt
Dim i As Integer, Arr(), x&
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox
Application.ScreenUpdating = False
If Sheets.Count > 40 Then
MsgBox "Trop de feuilles pour la boite de dialogue..."
Exit Sub
End If
' Ajoute une feuille de dialogue temporaire
If ActiveWindow.SelectedSheets.Count > 1 Then Sheets(1).Activate
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option
TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Ne tient pas compte des feuilles vide ou masquées
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.CheckBoxes.Add 78, TopPos, 120, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i
' Positionne les boutons OK et Annuler
PrintDlg.Buttons.Left = 200
' Dimensionne la hauteur, la largeur et le titre de la bte de dialogue
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 200
.Caption = "Feuille(s) à copier ? "
End With
' Change l'ordre de tabulation des boutons OK et Annuler
' afin de donner le focus au premier bouton d'option
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show = True Then
x = -1
Application.ScreenUpdating = False
For i = 1 To SheetCount
If PrintDlg.CheckBoxes(i).Value = xlOn Then
x = x + 1: ReDim Preserve Arr(x)
Arr(x) = PrintDlg.CheckBoxes(i).Caption
End If
Next i
Else: Exit Sub
End If
Else
MsgBox "Toutes les feuilles sont vides."
End If
' Supprime la feuille de dialogue temporaire (sans message d'avertissement)
Application.DisplayAlerts = False
PrintDlg.Delete
If x = -1 Then Exit Sub
' Sélectionne les feuilles et les copie dans un nouveau classeur
Sheets(Arr).Copy
' Elimine les formules et ne conserve que les valeurs
With ActiveWorkbook
For i = 1 To .Sheets.Count
.Sheets(i).UsedRange.Value = .Sheets(i).UsedRange.Value
Next i
End With
End Sub
'''''''''''''''''''''''''''
----------
Ange Ounis
----------
Bonjour et bonne année à tous,
J'ai dans un classeur, besoin de copier certains onglets qui ne sont pas
toujours les mêmes, cette copie doit se faire sans les formules (càd collage
spécial uniquement valeurs),dans un nouveau classeur.
De quelle manière peut-on créer une macro qui me demanderait de choisir les
feuilles à copier (genre userform).
Ce code, adaptation d'un code déjà diffusé, devrait répondre à ta demande une fois affecté à un bouton de barre d'outils :
''''''''''''''''''''''''''' 'construit une boite de dialogue temporaire pour sélectionner 'les feuilles que l'on souhaite copier dans un nouveau classeur
Sub ChoixFeuilles() 'd'après un code diffusé par René Roy, mpfe, disponible à cette adresse : 'http://frederic.sigonneau.free.fr/code/Impr/BoiteDialogueImprimerFeuilles.txt
Dim i As Integer, Arr(), x& Dim TopPos As Integer Dim SheetCount As Integer Dim PrintDlg As DialogSheet Dim CurrentSheet As Worksheet Dim cb As CheckBox
Application.ScreenUpdating = False
If Sheets.Count > 40 Then MsgBox "Trop de feuilles pour la boite de dialogue..." Exit Sub End If
' Ajoute une feuille de dialogue temporaire If ActiveWindow.SelectedSheets.Count > 1 Then Sheets(1).Activate Set PrintDlg = ActiveWorkbook.DialogSheets.Add PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option TopPos = 40 For i = 1 To ActiveWorkbook.Worksheets.Count Set CurrentSheet = ActiveWorkbook.Worksheets(i) ' Ne tient pas compte des feuilles vide ou masquées If Application.CountA(CurrentSheet.Cells) <> 0 And _ CurrentSheet.Visible Then SheetCount = SheetCount + 1 PrintDlg.CheckBoxes.Add 78, TopPos, 120, 16.5 PrintDlg.CheckBoxes(SheetCount).Text = CurrentSheet.Name TopPos = TopPos + 13 End If Next i
' Positionne les boutons OK et Annuler PrintDlg.Buttons.Left = 200
' Dimensionne la hauteur, la largeur et le titre de la bte de dialogue With PrintDlg.DialogFrame .Height = Application.Max _ (68, PrintDlg.DialogFrame.Top + TopPos - 34) .Width = 200 .Caption = "Feuille(s) à copier ? " End With
' Change l'ordre de tabulation des boutons OK et Annuler ' afin de donner le focus au premier bouton d'option PrintDlg.Buttons("Button 2").BringToFront PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue Application.ScreenUpdating = True If SheetCount <> 0 Then If PrintDlg.Show = True Then x = -1 Application.ScreenUpdating = False For i = 1 To SheetCount If PrintDlg.CheckBoxes(i).Value = xlOn Then x = x + 1: ReDim Preserve Arr(x) Arr(x) = PrintDlg.CheckBoxes(i).Caption End If Next i Else: Exit Sub End If Else MsgBox "Toutes les feuilles sont vides." End If
' Supprime la feuille de dialogue temporaire (sans message d'avertissement) Application.DisplayAlerts = False PrintDlg.Delete If x = -1 Then Exit Sub
' Sélectionne les feuilles et les copie dans un nouveau classeur Sheets(Arr).Copy
' Elimine les formules et ne conserve que les valeurs With ActiveWorkbook For i = 1 To .Sheets.Count .Sheets(i).UsedRange.Value = .Sheets(i).UsedRange.Value Next i End With
End Sub '''''''''''''''''''''''''''
---------- Ange Ounis ----------
Bonjour et bonne année à tous,
J'ai dans un classeur, besoin de copier certains onglets qui ne sont pas toujours les mêmes, cette copie doit se faire sans les formules (càd collage spécial uniquement valeurs),dans un nouveau classeur. De quelle manière peut-on créer une macro qui me demanderait de choisir les feuilles à copier (genre userform).
Jol
Bonjour Ange Ounis,
Super, c'est parfaitement ce que je recherchais, merci beaucoup
Jol
"Ange Ounis" a écrit dans le message de news:
Ce code, adaptation d'un code déjà diffusé, devrait répondre à ta demande une fois affecté à un bouton de barre d'outils :
''''''''''''''''''''''''''' 'construit une boite de dialogue temporaire pour sélectionner 'les feuilles que l'on souhaite copier dans un nouveau classeur
Sub ChoixFeuilles() 'd'après un code diffusé par René Roy, mpfe, disponible à cette adresse : 'http://frederic.sigonneau.free.fr/code/Impr/BoiteDialogueImprimerFeuilles.txt
Dim i As Integer, Arr(), x& Dim TopPos As Integer Dim SheetCount As Integer Dim PrintDlg As DialogSheet Dim CurrentSheet As Worksheet Dim cb As CheckBox
Application.ScreenUpdating = False
If Sheets.Count > 40 Then MsgBox "Trop de feuilles pour la boite de dialogue..." Exit Sub End If
' Ajoute une feuille de dialogue temporaire If ActiveWindow.SelectedSheets.Count > 1 Then Sheets(1).Activate Set PrintDlg = ActiveWorkbook.DialogSheets.Add PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option TopPos = 40 For i = 1 To ActiveWorkbook.Worksheets.Count Set CurrentSheet = ActiveWorkbook.Worksheets(i) ' Ne tient pas compte des feuilles vide ou masquées If Application.CountA(CurrentSheet.Cells) <> 0 And _ CurrentSheet.Visible Then SheetCount = SheetCount + 1 PrintDlg.CheckBoxes.Add 78, TopPos, 120, 16.5 PrintDlg.CheckBoxes(SheetCount).Text = CurrentSheet.Name TopPos = TopPos + 13 End If Next i
' Positionne les boutons OK et Annuler PrintDlg.Buttons.Left = 200
' Dimensionne la hauteur, la largeur et le titre de la bte de dialogue With PrintDlg.DialogFrame .Height = Application.Max _ (68, PrintDlg.DialogFrame.Top + TopPos - 34) .Width = 200 .Caption = "Feuille(s) à copier ? " End With
' Change l'ordre de tabulation des boutons OK et Annuler ' afin de donner le focus au premier bouton d'option PrintDlg.Buttons("Button 2").BringToFront PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue Application.ScreenUpdating = True If SheetCount <> 0 Then If PrintDlg.Show = True Then x = -1 Application.ScreenUpdating = False For i = 1 To SheetCount If PrintDlg.CheckBoxes(i).Value = xlOn Then x = x + 1: ReDim Preserve Arr(x) Arr(x) = PrintDlg.CheckBoxes(i).Caption End If Next i Else: Exit Sub End If Else MsgBox "Toutes les feuilles sont vides." End If
' Supprime la feuille de dialogue temporaire (sans message d'avertissement) Application.DisplayAlerts = False PrintDlg.Delete If x = -1 Then Exit Sub
' Sélectionne les feuilles et les copie dans un nouveau classeur Sheets(Arr).Copy
' Elimine les formules et ne conserve que les valeurs With ActiveWorkbook For i = 1 To .Sheets.Count .Sheets(i).UsedRange.Value = .Sheets(i).UsedRange.Value Next i End With
End Sub '''''''''''''''''''''''''''
---------- Ange Ounis ----------
Bonjour et bonne année à tous,
J'ai dans un classeur, besoin de copier certains onglets qui ne sont pas toujours les mêmes, cette copie doit se faire sans les formules (càd collage spécial uniquement valeurs),dans un nouveau classeur. De quelle manière peut-on créer une macro qui me demanderait de choisir les feuilles à copier (genre userform).
Bonjour Ange Ounis,
Super, c'est parfaitement ce que je recherchais, merci beaucoup
Jol
"Ange Ounis" <nospam@nospam> a écrit dans le message de news:
OlPh9kpLHHA.4928@TK2MSFTNGP06.phx.gbl...
Ce code, adaptation d'un code déjà diffusé, devrait répondre à ta demande
une fois affecté à un bouton de barre d'outils :
'''''''''''''''''''''''''''
'construit une boite de dialogue temporaire pour sélectionner
'les feuilles que l'on souhaite copier dans un nouveau classeur
Sub ChoixFeuilles()
'd'après un code diffusé par René Roy, mpfe, disponible à cette adresse :
'http://frederic.sigonneau.free.fr/code/Impr/BoiteDialogueImprimerFeuilles.txt
Dim i As Integer, Arr(), x&
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox
Application.ScreenUpdating = False
If Sheets.Count > 40 Then
MsgBox "Trop de feuilles pour la boite de dialogue..."
Exit Sub
End If
' Ajoute une feuille de dialogue temporaire
If ActiveWindow.SelectedSheets.Count > 1 Then Sheets(1).Activate
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option
TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Ne tient pas compte des feuilles vide ou masquées
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.CheckBoxes.Add 78, TopPos, 120, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i
' Positionne les boutons OK et Annuler
PrintDlg.Buttons.Left = 200
' Dimensionne la hauteur, la largeur et le titre de la bte de dialogue
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 200
.Caption = "Feuille(s) à copier ? "
End With
' Change l'ordre de tabulation des boutons OK et Annuler
' afin de donner le focus au premier bouton d'option
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show = True Then
x = -1
Application.ScreenUpdating = False
For i = 1 To SheetCount
If PrintDlg.CheckBoxes(i).Value = xlOn Then
x = x + 1: ReDim Preserve Arr(x)
Arr(x) = PrintDlg.CheckBoxes(i).Caption
End If
Next i
Else: Exit Sub
End If
Else
MsgBox "Toutes les feuilles sont vides."
End If
' Supprime la feuille de dialogue temporaire (sans message
d'avertissement)
Application.DisplayAlerts = False
PrintDlg.Delete
If x = -1 Then Exit Sub
' Sélectionne les feuilles et les copie dans un nouveau classeur
Sheets(Arr).Copy
' Elimine les formules et ne conserve que les valeurs
With ActiveWorkbook
For i = 1 To .Sheets.Count
.Sheets(i).UsedRange.Value = .Sheets(i).UsedRange.Value
Next i
End With
End Sub
'''''''''''''''''''''''''''
----------
Ange Ounis
----------
Bonjour et bonne année à tous,
J'ai dans un classeur, besoin de copier certains onglets qui ne sont pas
toujours les mêmes, cette copie doit se faire sans les formules (càd
collage spécial uniquement valeurs),dans un nouveau classeur.
De quelle manière peut-on créer une macro qui me demanderait de choisir
les feuilles à copier (genre userform).
Super, c'est parfaitement ce que je recherchais, merci beaucoup
Jol
"Ange Ounis" a écrit dans le message de news:
Ce code, adaptation d'un code déjà diffusé, devrait répondre à ta demande une fois affecté à un bouton de barre d'outils :
''''''''''''''''''''''''''' 'construit une boite de dialogue temporaire pour sélectionner 'les feuilles que l'on souhaite copier dans un nouveau classeur
Sub ChoixFeuilles() 'd'après un code diffusé par René Roy, mpfe, disponible à cette adresse : 'http://frederic.sigonneau.free.fr/code/Impr/BoiteDialogueImprimerFeuilles.txt
Dim i As Integer, Arr(), x& Dim TopPos As Integer Dim SheetCount As Integer Dim PrintDlg As DialogSheet Dim CurrentSheet As Worksheet Dim cb As CheckBox
Application.ScreenUpdating = False
If Sheets.Count > 40 Then MsgBox "Trop de feuilles pour la boite de dialogue..." Exit Sub End If
' Ajoute une feuille de dialogue temporaire If ActiveWindow.SelectedSheets.Count > 1 Then Sheets(1).Activate Set PrintDlg = ActiveWorkbook.DialogSheets.Add PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option TopPos = 40 For i = 1 To ActiveWorkbook.Worksheets.Count Set CurrentSheet = ActiveWorkbook.Worksheets(i) ' Ne tient pas compte des feuilles vide ou masquées If Application.CountA(CurrentSheet.Cells) <> 0 And _ CurrentSheet.Visible Then SheetCount = SheetCount + 1 PrintDlg.CheckBoxes.Add 78, TopPos, 120, 16.5 PrintDlg.CheckBoxes(SheetCount).Text = CurrentSheet.Name TopPos = TopPos + 13 End If Next i
' Positionne les boutons OK et Annuler PrintDlg.Buttons.Left = 200
' Dimensionne la hauteur, la largeur et le titre de la bte de dialogue With PrintDlg.DialogFrame .Height = Application.Max _ (68, PrintDlg.DialogFrame.Top + TopPos - 34) .Width = 200 .Caption = "Feuille(s) à copier ? " End With
' Change l'ordre de tabulation des boutons OK et Annuler ' afin de donner le focus au premier bouton d'option PrintDlg.Buttons("Button 2").BringToFront PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue Application.ScreenUpdating = True If SheetCount <> 0 Then If PrintDlg.Show = True Then x = -1 Application.ScreenUpdating = False For i = 1 To SheetCount If PrintDlg.CheckBoxes(i).Value = xlOn Then x = x + 1: ReDim Preserve Arr(x) Arr(x) = PrintDlg.CheckBoxes(i).Caption End If Next i Else: Exit Sub End If Else MsgBox "Toutes les feuilles sont vides." End If
' Supprime la feuille de dialogue temporaire (sans message d'avertissement) Application.DisplayAlerts = False PrintDlg.Delete If x = -1 Then Exit Sub
' Sélectionne les feuilles et les copie dans un nouveau classeur Sheets(Arr).Copy
' Elimine les formules et ne conserve que les valeurs With ActiveWorkbook For i = 1 To .Sheets.Count .Sheets(i).UsedRange.Value = .Sheets(i).UsedRange.Value Next i End With
End Sub '''''''''''''''''''''''''''
---------- Ange Ounis ----------
Bonjour et bonne année à tous,
J'ai dans un classeur, besoin de copier certains onglets qui ne sont pas toujours les mêmes, cette copie doit se faire sans les formules (càd collage spécial uniquement valeurs),dans un nouveau classeur. De quelle manière peut-on créer une macro qui me demanderait de choisir les feuilles à copier (genre userform).
