Bonjour J-Pascal,
Je n'ai pas vraiment compris ce que tu désires faire, mais si tu veux
que le filtre débute à la ligne 10 plutôt qu'à la ligne 15
Tu n'a qu'à modifier cette ligne de code :
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
Pour
Set Rg = .Range("B10:B" & .Range("b65536").End(xlUp).Row)
Change la valeur 15 pour la valeur 10.
"j-pascal" a écrit dans le message de groupe de
discussion : Bonsoir,
Dans le code qui suit (que je dois à MichDenis), seules les valeurs
situées sur les lignes 16 et plus sont fitrées ...
J'avais renoncé à exporter quelques lignes situées au dessus de ce
tableau mais finalement ça me fait défaut.
J'ai donc tenté de modifier le code pour exporter les valeurs
récurentes situées sur les lignes 10 à 14 ! Sans succès !!
Précision : ces 5 lignes seraient répétées comme dans "MiseEnPage /
Feuille / Lignes à répéter en haut".
Y-a-t-il peu de choses à changer dans le présent code pour que je
parvienne à mon but ?
'---------------------------
With ActiveSheet
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
Set Sh = Worksheets.Add
On Error Resume Next
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
Worksheets(.Parent.Name).ShowAllData
End With
With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy
Sh1.Range("A1")
Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
End With
'---------------------------
Merci pour votre aide,
JP
Bonjour J-Pascal,
Je n'ai pas vraiment compris ce que tu désires faire, mais si tu veux
que le filtre débute à la ligne 10 plutôt qu'à la ligne 15
Tu n'a qu'à modifier cette ligne de code :
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
Pour
Set Rg = .Range("B10:B" & .Range("b65536").End(xlUp).Row)
Change la valeur 15 pour la valeur 10.
"j-pascal" <messages@venir.com> a écrit dans le message de groupe de
discussion : mn.e00f7d94363a1c42.81386@venir.com... Bonsoir,
Dans le code qui suit (que je dois à MichDenis), seules les valeurs
situées sur les lignes 16 et plus sont fitrées ...
J'avais renoncé à exporter quelques lignes situées au dessus de ce
tableau mais finalement ça me fait défaut.
J'ai donc tenté de modifier le code pour exporter les valeurs
récurentes situées sur les lignes 10 à 14 ! Sans succès !!
Précision : ces 5 lignes seraient répétées comme dans "MiseEnPage /
Feuille / Lignes à répéter en haut".
Y-a-t-il peu de choses à changer dans le présent code pour que je
parvienne à mon but ?
'---------------------------
With ActiveSheet
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
Set Sh = Worksheets.Add
On Error Resume Next
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
Worksheets(.Parent.Name).ShowAllData
End With
With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy
Sh1.Range("A1")
Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
End With
'---------------------------
Merci pour votre aide,
JP
Bonjour J-Pascal,
Je n'ai pas vraiment compris ce que tu désires faire, mais si tu veux
que le filtre débute à la ligne 10 plutôt qu'à la ligne 15
Tu n'a qu'à modifier cette ligne de code :
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
Pour
Set Rg = .Range("B10:B" & .Range("b65536").End(xlUp).Row)
Change la valeur 15 pour la valeur 10.
"j-pascal" a écrit dans le message de groupe de
discussion : Bonsoir,
Dans le code qui suit (que je dois à MichDenis), seules les valeurs
situées sur les lignes 16 et plus sont fitrées ...
J'avais renoncé à exporter quelques lignes situées au dessus de ce
tableau mais finalement ça me fait défaut.
J'ai donc tenté de modifier le code pour exporter les valeurs
récurentes situées sur les lignes 10 à 14 ! Sans succès !!
Précision : ces 5 lignes seraient répétées comme dans "MiseEnPage /
Feuille / Lignes à répéter en haut".
Y-a-t-il peu de choses à changer dans le présent code pour que je
parvienne à mon but ?
'---------------------------
With ActiveSheet
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
Set Sh = Worksheets.Add
On Error Resume Next
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
Worksheets(.Parent.Name).ShowAllData
End With
With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy
Sh1.Range("A1")
Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
End With
'---------------------------
Merci pour votre aide,
JP
Actuellement, la ligne qui sert de référence au filtre est la n° 15.
Toutes les lignes inférieures sont donc filtrées.
Je n'ai rien compris !
Tu exécutes un filtre automatique ? Si tu veux modifier la plage
sur laquelle s'exerce le filtre, mon message précédent t'indique
comment faire.
"j-pascal" a écrit dans le message de groupe de
discussion : Bonjour Denis,
Je redoutais de m'être mal exprimé ...
Actuellement, la ligne qui sert de référence au filtre est la n° 15.
Toutes les lignes inférieures sont donc filtrées.
Sur mon classeur d'origine, de la ligne 1 à 14, j'ai des données :
Numéro de la semaine,
Message au destinataire,
Nom du fichier extrait,
etc.
(Actuellement) les classeurs exportés replacent la ligne 15 (de titre)
du classeur d'origine à la ligne 1 du nouveau classeur (ou plutôt de la
nouvelle feuille).
J'aimerais que les lignes 10 à 14 (ie) du classeur d'origine soient
systématiquement copiées dans les nouvelles feuilles créées et que la
ligne de titre commence (donc) à la ligne 6 (ie).
En fait, ces données "communes" sont nécessaires aux destinataires des
classeurs. Si c'est possible, je préfère qu'elles fassent partie des
classeurs (feuilles) créés plutôt que d'avoir à les recopier dans un
autre fichier ou dans le corps d'un mail (ie).
Dans ce cas, l'adaptation de ton code est pour moi impossible.
Si ce n'est toujours pas clair, dis moi.
JPBonjour J-Pascal,
Je n'ai pas vraiment compris ce que tu désires faire, mais si tu veux
que le filtre débute à la ligne 10 plutôt qu'à la ligne 15
Tu n'a qu'à modifier cette ligne de code :
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
Pour
Set Rg = .Range("B10:B" & .Range("b65536").End(xlUp).Row)
Change la valeur 15 pour la valeur 10.
"j-pascal" a écrit dans le message de groupe de
discussion : Bonsoir,
Dans le code qui suit (que je dois à MichDenis), seules les valeurs
situées sur les lignes 16 et plus sont fitrées ...
J'avais renoncé à exporter quelques lignes situées au dessus de ce
tableau mais finalement ça me fait défaut.
J'ai donc tenté de modifier le code pour exporter les valeurs
récurentes situées sur les lignes 10 à 14 ! Sans succès !!
Précision : ces 5 lignes seraient répétées comme dans "MiseEnPage /
Feuille / Lignes à répéter en haut".
Y-a-t-il peu de choses à changer dans le présent code pour que je
parvienne à mon but ?
'---------------------------
With ActiveSheet
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
Set Sh = Worksheets.Add
On Error Resume Next
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
Worksheets(.Parent.Name).ShowAllData
End With
With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy
Sh1.Range("A1")
Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
End With
'---------------------------
Merci pour votre aide,
JP
Actuellement, la ligne qui sert de référence au filtre est la n° 15.
Toutes les lignes inférieures sont donc filtrées.
Je n'ai rien compris !
Tu exécutes un filtre automatique ? Si tu veux modifier la plage
sur laquelle s'exerce le filtre, mon message précédent t'indique
comment faire.
"j-pascal" <messages@venir.com> a écrit dans le message de groupe de
discussion : mn.e1f97d9413a32dd6.81386@venir.com... Bonjour Denis,
Je redoutais de m'être mal exprimé ...
Actuellement, la ligne qui sert de référence au filtre est la n° 15.
Toutes les lignes inférieures sont donc filtrées.
Sur mon classeur d'origine, de la ligne 1 à 14, j'ai des données :
Numéro de la semaine,
Message au destinataire,
Nom du fichier extrait,
etc.
(Actuellement) les classeurs exportés replacent la ligne 15 (de titre)
du classeur d'origine à la ligne 1 du nouveau classeur (ou plutôt de la
nouvelle feuille).
J'aimerais que les lignes 10 à 14 (ie) du classeur d'origine soient
systématiquement copiées dans les nouvelles feuilles créées et que la
ligne de titre commence (donc) à la ligne 6 (ie).
En fait, ces données "communes" sont nécessaires aux destinataires des
classeurs. Si c'est possible, je préfère qu'elles fassent partie des
classeurs (feuilles) créés plutôt que d'avoir à les recopier dans un
autre fichier ou dans le corps d'un mail (ie).
Dans ce cas, l'adaptation de ton code est pour moi impossible.
Si ce n'est toujours pas clair, dis moi.
JP
Bonjour J-Pascal,
Je n'ai pas vraiment compris ce que tu désires faire, mais si tu veux
que le filtre débute à la ligne 10 plutôt qu'à la ligne 15
Tu n'a qu'à modifier cette ligne de code :
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
Pour
Set Rg = .Range("B10:B" & .Range("b65536").End(xlUp).Row)
Change la valeur 15 pour la valeur 10.
"j-pascal" <messages@venir.com> a écrit dans le message de groupe de
discussion : mn.e00f7d94363a1c42.81386@venir.com... Bonsoir,
Dans le code qui suit (que je dois à MichDenis), seules les valeurs
situées sur les lignes 16 et plus sont fitrées ...
J'avais renoncé à exporter quelques lignes situées au dessus de ce
tableau mais finalement ça me fait défaut.
J'ai donc tenté de modifier le code pour exporter les valeurs
récurentes situées sur les lignes 10 à 14 ! Sans succès !!
Précision : ces 5 lignes seraient répétées comme dans "MiseEnPage /
Feuille / Lignes à répéter en haut".
Y-a-t-il peu de choses à changer dans le présent code pour que je
parvienne à mon but ?
'---------------------------
With ActiveSheet
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
Set Sh = Worksheets.Add
On Error Resume Next
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
Worksheets(.Parent.Name).ShowAllData
End With
With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy
Sh1.Range("A1")
Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
End With
'---------------------------
Merci pour votre aide,
JP
Actuellement, la ligne qui sert de référence au filtre est la n° 15.
Toutes les lignes inférieures sont donc filtrées.
Je n'ai rien compris !
Tu exécutes un filtre automatique ? Si tu veux modifier la plage
sur laquelle s'exerce le filtre, mon message précédent t'indique
comment faire.
"j-pascal" a écrit dans le message de groupe de
discussion : Bonjour Denis,
Je redoutais de m'être mal exprimé ...
Actuellement, la ligne qui sert de référence au filtre est la n° 15.
Toutes les lignes inférieures sont donc filtrées.
Sur mon classeur d'origine, de la ligne 1 à 14, j'ai des données :
Numéro de la semaine,
Message au destinataire,
Nom du fichier extrait,
etc.
(Actuellement) les classeurs exportés replacent la ligne 15 (de titre)
du classeur d'origine à la ligne 1 du nouveau classeur (ou plutôt de la
nouvelle feuille).
J'aimerais que les lignes 10 à 14 (ie) du classeur d'origine soient
systématiquement copiées dans les nouvelles feuilles créées et que la
ligne de titre commence (donc) à la ligne 6 (ie).
En fait, ces données "communes" sont nécessaires aux destinataires des
classeurs. Si c'est possible, je préfère qu'elles fassent partie des
classeurs (feuilles) créés plutôt que d'avoir à les recopier dans un
autre fichier ou dans le corps d'un mail (ie).
Dans ce cas, l'adaptation de ton code est pour moi impossible.
Si ce n'est toujours pas clair, dis moi.
JPBonjour J-Pascal,
Je n'ai pas vraiment compris ce que tu désires faire, mais si tu veux
que le filtre débute à la ligne 10 plutôt qu'à la ligne 15
Tu n'a qu'à modifier cette ligne de code :
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
Pour
Set Rg = .Range("B10:B" & .Range("b65536").End(xlUp).Row)
Change la valeur 15 pour la valeur 10.
"j-pascal" a écrit dans le message de groupe de
discussion : Bonsoir,
Dans le code qui suit (que je dois à MichDenis), seules les valeurs
situées sur les lignes 16 et plus sont fitrées ...
J'avais renoncé à exporter quelques lignes situées au dessus de ce
tableau mais finalement ça me fait défaut.
J'ai donc tenté de modifier le code pour exporter les valeurs
récurentes situées sur les lignes 10 à 14 ! Sans succès !!
Précision : ces 5 lignes seraient répétées comme dans "MiseEnPage /
Feuille / Lignes à répéter en haut".
Y-a-t-il peu de choses à changer dans le présent code pour que je
parvienne à mon but ?
'---------------------------
With ActiveSheet
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
Set Sh = Worksheets.Add
On Error Resume Next
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
Worksheets(.Parent.Name).ShowAllData
End With
With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy
Sh1.Range("A1")
Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
End With
'---------------------------
Merci pour votre aide,
JP
With ActiveSheet
PlgACopier = .Range("A1:A5").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
With ActiveSheet
PlgACopier = .Range("A1:A5").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
With ActiveSheet
PlgACopier = .Range("A1:A5").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
With ActiveSheet
PlgACopier = .Range("A1:A5").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
With ActiveSheet
PlgACopier = .Range("A1:A5").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
With ActiveSheet
PlgACopier = .Range("A1:A5").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
Il manque un petit mot "Set"
set PlgACopier = .Range("A1:A5").EntireRow
"j-pascal" a écrit dans le message de groupe de
discussion : Bonsoir Denis,
Je te remercie pour ta patience.
Dans :With ActiveSheet
PlgACopier = .Range("A1:A5").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
j'ai un pb avec : "PlgACopier = .Range("A1:A5").EntireRow"
Cette ligne n'est pas prise en compte et j'ignore vraiment pourquoi !
Si je mets "On error resume next" juste avant cette ligne, je passe à
la suivante (Set Reg ...), sinon ça me fait sortir de la procédure !
Ca fait un moment que je cherche, mais je ne trouve pas !
Je continue ...
JP
PS : sinon, j'imagine que cette solution répond parfaitement à mes
attentes.
Il manque un petit mot "Set"
set PlgACopier = .Range("A1:A5").EntireRow
"j-pascal" <messages@venir.com> a écrit dans le message de groupe de
discussion : mn.e4e97d944702ab82.81386@venir.com... Bonsoir Denis,
Je te remercie pour ta patience.
Dans :
With ActiveSheet
PlgACopier = .Range("A1:A5").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
j'ai un pb avec : "PlgACopier = .Range("A1:A5").EntireRow"
Cette ligne n'est pas prise en compte et j'ignore vraiment pourquoi !
Si je mets "On error resume next" juste avant cette ligne, je passe à
la suivante (Set Reg ...), sinon ça me fait sortir de la procédure !
Ca fait un moment que je cherche, mais je ne trouve pas !
Je continue ...
JP
PS : sinon, j'imagine que cette solution répond parfaitement à mes
attentes.
Il manque un petit mot "Set"
set PlgACopier = .Range("A1:A5").EntireRow
"j-pascal" a écrit dans le message de groupe de
discussion : Bonsoir Denis,
Je te remercie pour ta patience.
Dans :With ActiveSheet
PlgACopier = .Range("A1:A5").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
j'ai un pb avec : "PlgACopier = .Range("A1:A5").EntireRow"
Cette ligne n'est pas prise en compte et j'ignore vraiment pourquoi !
Si je mets "On error resume next" juste avant cette ligne, je passe à
la suivante (Set Reg ...), sinon ça me fait sortir de la procédure !
Ca fait un moment que je cherche, mais je ne trouve pas !
Je continue ...
JP
PS : sinon, j'imagine que cette solution répond parfaitement à mes
attentes.
Sub Export_Relances()
Dim Rg As Range, Rg1 As Range, C As Range
Dim Sh As Worksheet, Sh1 As Worksheet, Chemin As String
Dim Plage_Infos_Communes As Range, Nom As String
Chemin = Path_Bureau & ""
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le "" & chemin & "" & Inexistant.", _
vbCritical + vbOKOnly, "Attention"
Exit Sub
End If
Chemin = Chemin & Format(Now, "yyyy-mm-dd HH`MM`SS")
MkDir Chemin
Application.ScreenUpdating = False
On Error Resume Next
With ActiveSheet
Nom = .Name
'àajuster
Set Plage_Infos_Communes = .Range("A8:A12").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
Set Sh = Worksheets.Add
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
End With
With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
Plage_Infos_Communes.Copy Sh1.Range("A1") 'erreur plus haut ??
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Sh1.Range("A6")
Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
End With
Sh1.Copy
With ActiveWorkbook
If Val(Application.Version) > 11 Then
.SaveAs Chemin & "" & C.Value & ".xlsx"
Else
.SaveAs Chemin & "" & C.Value & ".xls"
End If
.Close False
End With
Application.DisplayAlerts = False
Sh1.Delete
Application.DisplayAlerts = True
Next
Rg.AutoFilter
Application.DisplayAlerts = False
Sh.Delete
Sheets(Nom).Select
Application.DisplayAlerts = True
Application.ScreenUpdating = False
End Sub
"j-pascal" a écrit dans le message de groupe de
discussion : Suis complètement perdu
!!
Voilà mes modifs, et pourtant ça ne copie pas les fameuses lignes ! :
'----------
Sub Export_Relances()
Dim Rg As Range, Rg1 As Range, C As Range
Dim Sh As Worksheet, Sh1 As Worksheet, Chemin As String
Dim Plage_Infos_Communes As Range 'ajout 28/04
Chemin = Path_Bureau & ""
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le "" & chemin & "" & Inexistant.", vbCritical +
vbOKOnly, "Attention"
Exit Sub
End If
Chemin = Chemin & Format(Now, "yyyy-mm-dd HH`MM`SS")
MkDir Chemin
Stop
'Application.ScreenUpdating = False '28/04
On Error Resume Next
With ActiveSheet
Set Plage_Infos_Communes = .Range("A8:A12").EntireRow 'à
ajuster
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
Set Sh = Worksheets.Add
On Error Resume Next
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
Worksheets(.Parent.Name).ShowAllData
End With
With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
Plage_Infos_Communes.Copy Sh.Range("A1") 'erreur plus haut ??
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy
Sh1.Range("A6")
'Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
'attention col.
End With
Sh1.Copy
With ActiveWorkbook
If Val(Application.Version) > 11 Then
.SaveAs Chemin & "" & C.Value & ".xlsm"
Else
.SaveAs Chemin & "" & C.Value & ".xls"
End If
.Close False
End With
Application.DisplayAlerts = False
Sh1.Delete
Application.DisplayAlerts = True
Next
Rg.AutoFilter
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
End Sub
'----------
jpIl manque un petit mot "Set"
set PlgACopier = .Range("A1:A5").EntireRow
"j-pascal" a écrit dans le message de groupe de
discussion : Bonsoir Denis,
Je te remercie pour ta patience.
Dans :With ActiveSheet
PlgACopier = .Range("A1:A5").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
j'ai un pb avec : "PlgACopier = .Range("A1:A5").EntireRow"
Cette ligne n'est pas prise en compte et j'ignore vraiment pourquoi !
Si je mets "On error resume next" juste avant cette ligne, je passe à
la suivante (Set Reg ...), sinon ça me fait sortir de la procédure !
Ca fait un moment que je cherche, mais je ne trouve pas !
Je continue ...
JP
PS : sinon, j'imagine que cette solution répond parfaitement à mes
attentes.
Sub Export_Relances()
Dim Rg As Range, Rg1 As Range, C As Range
Dim Sh As Worksheet, Sh1 As Worksheet, Chemin As String
Dim Plage_Infos_Communes As Range, Nom As String
Chemin = Path_Bureau & ""
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le "" & chemin & "" & Inexistant.", _
vbCritical + vbOKOnly, "Attention"
Exit Sub
End If
Chemin = Chemin & Format(Now, "yyyy-mm-dd HH`MM`SS")
MkDir Chemin
Application.ScreenUpdating = False
On Error Resume Next
With ActiveSheet
Nom = .Name
'àajuster
Set Plage_Infos_Communes = .Range("A8:A12").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
Set Sh = Worksheets.Add
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
End With
With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
Plage_Infos_Communes.Copy Sh1.Range("A1") 'erreur plus haut ??
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Sh1.Range("A6")
Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
End With
Sh1.Copy
With ActiveWorkbook
If Val(Application.Version) > 11 Then
.SaveAs Chemin & "" & C.Value & ".xlsx"
Else
.SaveAs Chemin & "" & C.Value & ".xls"
End If
.Close False
End With
Application.DisplayAlerts = False
Sh1.Delete
Application.DisplayAlerts = True
Next
Rg.AutoFilter
Application.DisplayAlerts = False
Sh.Delete
Sheets(Nom).Select
Application.DisplayAlerts = True
Application.ScreenUpdating = False
End Sub
"j-pascal" <messages@venir.com> a écrit dans le message de groupe de
discussion : mn.e5137d94238d9990.81386@venir.com... Suis complètement perdu
!!
Voilà mes modifs, et pourtant ça ne copie pas les fameuses lignes ! :
'----------
Sub Export_Relances()
Dim Rg As Range, Rg1 As Range, C As Range
Dim Sh As Worksheet, Sh1 As Worksheet, Chemin As String
Dim Plage_Infos_Communes As Range 'ajout 28/04
Chemin = Path_Bureau & ""
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le "" & chemin & "" & Inexistant.", vbCritical +
vbOKOnly, "Attention"
Exit Sub
End If
Chemin = Chemin & Format(Now, "yyyy-mm-dd HH`MM`SS")
MkDir Chemin
Stop
'Application.ScreenUpdating = False '28/04
On Error Resume Next
With ActiveSheet
Set Plage_Infos_Communes = .Range("A8:A12").EntireRow 'à
ajuster
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
Set Sh = Worksheets.Add
On Error Resume Next
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
Worksheets(.Parent.Name).ShowAllData
End With
With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
Plage_Infos_Communes.Copy Sh.Range("A1") 'erreur plus haut ??
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy
Sh1.Range("A6")
'Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
'attention col.
End With
Sh1.Copy
With ActiveWorkbook
If Val(Application.Version) > 11 Then
.SaveAs Chemin & "" & C.Value & ".xlsm"
Else
.SaveAs Chemin & "" & C.Value & ".xls"
End If
.Close False
End With
Application.DisplayAlerts = False
Sh1.Delete
Application.DisplayAlerts = True
Next
Rg.AutoFilter
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
End Sub
'----------
jp
Il manque un petit mot "Set"
set PlgACopier = .Range("A1:A5").EntireRow
"j-pascal" <messages@venir.com> a écrit dans le message de groupe de
discussion : mn.e4e97d944702ab82.81386@venir.com... Bonsoir Denis,
Je te remercie pour ta patience.
Dans :
With ActiveSheet
PlgACopier = .Range("A1:A5").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
j'ai un pb avec : "PlgACopier = .Range("A1:A5").EntireRow"
Cette ligne n'est pas prise en compte et j'ignore vraiment pourquoi !
Si je mets "On error resume next" juste avant cette ligne, je passe à
la suivante (Set Reg ...), sinon ça me fait sortir de la procédure !
Ca fait un moment que je cherche, mais je ne trouve pas !
Je continue ...
JP
PS : sinon, j'imagine que cette solution répond parfaitement à mes
attentes.
Sub Export_Relances()
Dim Rg As Range, Rg1 As Range, C As Range
Dim Sh As Worksheet, Sh1 As Worksheet, Chemin As String
Dim Plage_Infos_Communes As Range, Nom As String
Chemin = Path_Bureau & ""
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le "" & chemin & "" & Inexistant.", _
vbCritical + vbOKOnly, "Attention"
Exit Sub
End If
Chemin = Chemin & Format(Now, "yyyy-mm-dd HH`MM`SS")
MkDir Chemin
Application.ScreenUpdating = False
On Error Resume Next
With ActiveSheet
Nom = .Name
'àajuster
Set Plage_Infos_Communes = .Range("A8:A12").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
Set Sh = Worksheets.Add
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
End With
With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
Plage_Infos_Communes.Copy Sh1.Range("A1") 'erreur plus haut ??
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Sh1.Range("A6")
Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
End With
Sh1.Copy
With ActiveWorkbook
If Val(Application.Version) > 11 Then
.SaveAs Chemin & "" & C.Value & ".xlsx"
Else
.SaveAs Chemin & "" & C.Value & ".xls"
End If
.Close False
End With
Application.DisplayAlerts = False
Sh1.Delete
Application.DisplayAlerts = True
Next
Rg.AutoFilter
Application.DisplayAlerts = False
Sh.Delete
Sheets(Nom).Select
Application.DisplayAlerts = True
Application.ScreenUpdating = False
End Sub
"j-pascal" a écrit dans le message de groupe de
discussion : Suis complètement perdu
!!
Voilà mes modifs, et pourtant ça ne copie pas les fameuses lignes ! :
'----------
Sub Export_Relances()
Dim Rg As Range, Rg1 As Range, C As Range
Dim Sh As Worksheet, Sh1 As Worksheet, Chemin As String
Dim Plage_Infos_Communes As Range 'ajout 28/04
Chemin = Path_Bureau & ""
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le "" & chemin & "" & Inexistant.", vbCritical +
vbOKOnly, "Attention"
Exit Sub
End If
Chemin = Chemin & Format(Now, "yyyy-mm-dd HH`MM`SS")
MkDir Chemin
Stop
'Application.ScreenUpdating = False '28/04
On Error Resume Next
With ActiveSheet
Set Plage_Infos_Communes = .Range("A8:A12").EntireRow 'à
ajuster
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
Set Sh = Worksheets.Add
On Error Resume Next
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A1"), True
Worksheets(.Parent.Name).ShowAllData
End With
With Sh
Set Rg1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = C.Value
Plage_Infos_Communes.Copy Sh.Range("A1") 'erreur plus haut ??
With Rg
.AutoFilter field:=1, Criteria1:=C.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy
Sh1.Range("A6")
'Sh1.Range("A1").Range("A1").CurrentRegion.EntireColumn.AutoFit
'attention col.
End With
Sh1.Copy
With ActiveWorkbook
If Val(Application.Version) > 11 Then
.SaveAs Chemin & "" & C.Value & ".xlsm"
Else
.SaveAs Chemin & "" & C.Value & ".xls"
End If
.Close False
End With
Application.DisplayAlerts = False
Sh1.Delete
Application.DisplayAlerts = True
Next
Rg.AutoFilter
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
End Sub
'----------
jpIl manque un petit mot "Set"
set PlgACopier = .Range("A1:A5").EntireRow
"j-pascal" a écrit dans le message de groupe de
discussion : Bonsoir Denis,
Je te remercie pour ta patience.
Dans :With ActiveSheet
PlgACopier = .Range("A1:A5").EntireRow
Set Rg = .Range("B15:B" & .Range("b65536").End(xlUp).Row)
End With
j'ai un pb avec : "PlgACopier = .Range("A1:A5").EntireRow"
Cette ligne n'est pas prise en compte et j'ignore vraiment pourquoi !
Si je mets "On error resume next" juste avant cette ligne, je passe à
la suivante (Set Reg ...), sinon ça me fait sortir de la procédure !
Ca fait un moment que je cherche, mais je ne trouve pas !
Je continue ...
JP
PS : sinon, j'imagine que cette solution répond parfaitement à mes
attentes.
Sh1.Range("A6").Range("A6").CurrentRegion.EntireColumn.AutoFit
Tu n'as pas besoin de ma permission pour supprimer un des "Range("A6")
Do you ?
"j-pascal" a écrit dans le message de groupe de
discussion : C'était bien ça !
Sachant que "A6" est le début de mon tableau filtré, j'ai donc adapté
comme ceci :
'--
Sh1.Range("A6").Range("A6").CurrentRegion.EntireColumn.AutoFit
'--
Je ne comprends pas pourquoi on a deux fois "Range("A6")" !
Mais plutôt que de passer par un ".CurrentRegion.EntireColumn.AutoFit",
est-il possible de copier dans le classeur (Feuille) de destination,
les mêmes largeurs de colonnes que celles du tableau de référence ?
jp
Sh1.Range("A6").Range("A6").CurrentRegion.EntireColumn.AutoFit
Tu n'as pas besoin de ma permission pour supprimer un des "Range("A6")
Do you ?
"j-pascal" <messages@venir.com> a écrit dans le message de groupe de
discussion : mn.e5797d94e6996820.81386@venir.com... C'était bien ça !
Sachant que "A6" est le début de mon tableau filtré, j'ai donc adapté
comme ceci :
'--
Sh1.Range("A6").Range("A6").CurrentRegion.EntireColumn.AutoFit
'--
Je ne comprends pas pourquoi on a deux fois "Range("A6")" !
Mais plutôt que de passer par un ".CurrentRegion.EntireColumn.AutoFit",
est-il possible de copier dans le classeur (Feuille) de destination,
les mêmes largeurs de colonnes que celles du tableau de référence ?
jp
Sh1.Range("A6").Range("A6").CurrentRegion.EntireColumn.AutoFit
Tu n'as pas besoin de ma permission pour supprimer un des "Range("A6")
Do you ?
"j-pascal" a écrit dans le message de groupe de
discussion : C'était bien ça !
Sachant que "A6" est le début de mon tableau filtré, j'ai donc adapté
comme ceci :
'--
Sh1.Range("A6").Range("A6").CurrentRegion.EntireColumn.AutoFit
'--
Je ne comprends pas pourquoi on a deux fois "Range("A6")" !
Mais plutôt que de passer par un ".CurrentRegion.EntireColumn.AutoFit",
est-il possible de copier dans le classeur (Feuille) de destination,
les mêmes largeurs de colonnes que celles du tableau de référence ?
jp