Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Ventilation

Ventilation

15 réponses
Avatar
Philippe
Bonjoura tous,

Novice en Visual Basic, je souhaiterai votre aide
J' ai un classeur comportant plusieurs feuilles dont la principale "Saisie
des écritures" est ventilé sur plusieurs feuilles de "ADH001" à "ADH150"
J'ai adapté le programme VB suivant


Private Sub CommandButton1_Click()

Dim c As Range, Plage As Range

Dim LigneA As Long, LigneB As Long, LigneC As Long

LigneADH001 = Sheets("ADH001").Range("A65536").End(xlUp).Row

LigneADH002 = Sheets("ADH002").Range("A65536").End(xlUp).Row

Set Plage = Range("A2", Range("A65536").End(xlUp))

For Each c In Plage

If c.Offset(, 7) = "" Then

Select Case c.Offset(, 1)

Case "ADH001"

Sheets("ADH001").Select

ActiveSheet.Unprotect

LigneADH001 = LigneADH001 + 1

Sheets("ADH001").Range("A" & LigneADH001) = c.Value

Sheets("ADH001").Range("B" & LigneADH001) = c.Offset(,
1).Value

Sheets("ADH001").Range("C" & LigneADH001) = c.Offset(,
2).Value

Sheets("ADH001").Range("D" & LigneADH001) = c.Offset(,
3).Value

Sheets("ADH001").Range("E" & LigneADH001) = c.Offset(,
4).Value

Sheets("ADH001").Range("F" & LigneADH001) = c.Offset(,
5).Value

Sheets("ADH001").Range("G" & LigneADH001) = c.Offset(,
6).Value

Sheets("ADH001").Select

ActiveSheet.Protect

Case "ADH002"

Sheets("ADH002").Unprotect

LigneADH002 = LigneADH002 + 1

Sheets("ADH002").Range("A" & LigneADH002) = c.Value

Sheets("ADH002").Range("B" & LigneADH002) = c.Offset(,
1).Value

Sheets("ADH002").Range("C" & LigneADH002) = c.Offset(,
2).Value

Sheets("ADH002").Range("D" & LigneADH002) = c.Offset(,
3).Value

Sheets("ADH002").Range("E" & LigneADH002) = c.Offset(,
4).Value

Sheets("ADH002").Range("F" & LigneADH002) = c.Offset(,
5).Value

Sheets("ADH002").Range("G" & LigneADH002) = c.Offset(,
6).Value

Sheets("ADH002").Protect

End Select

Sheets("Saisie des écritures").Unprotect

c.Offset(, 7) = "X"

End If

Next c

Sheets("Saisie des écritures").Select

ActiveSheet.Unprotect

Range("A2:H60000").Select

Selection.Sort key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2")
_

, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=
_

False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _

:=xlSortNormal

Range("A4").Select

ActiveSheet.Protect

Sheets("INTERFACE").Select

End Sub

Sub Accueil()

'

' Accueil Macro

' Macro enregistrée le 02/11/2006 par Philippe





Je peux ventiler les écritures jusqu'à la feuille "ADH065"

après je suis confronté a une erreur de compilation "procédure trop
longue"



Pouvez vous me venir en aide



Merci d'avance



Philippe
Signaler un problème avec ce contenu

5 réponses

Supprimer
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
1 2
Avatar
FxM
Pourrais-tu mettre ton fichier sur cjoint.com ou en bal perso:
7m8a9aafg9zpqq1 @ jetable.net (enlever les espaces)

@+
FxM



Re-Bonjour
Je ne suis pas plus avancé pour autant
Merci de votre aide
Philippe

"FxM" a écrit dans le message de news:

Cette ligne est la généralisation de :
Select Case c.Offset(, 1)
Case "ADH001"
Sheets("ADH001").Select
équivalent à : si c.offset(,1)="ADH001" alors feuille("ADH001").select

Se pourrait-il que certains c.offset(0,1) ne correspondent pas à un nom de
feuille ? L'équivalent d'un "case else" en quelque sorte.

@+
FxM





Re Bonjour
Dans les 2 programmes essayés j'ai l'ereur "Sheets(c.Offset(,
1)).Select"

"FxM" a écrit dans le message de news:
%
Voire même : (déplacement de la détection de dernière ligne)

Non testé :
Private Sub CommandButton1_Click()
Dim c As Range, Plage As Range, a as integer
Dim derlig as long

Set Plage = Range("A2", Range("A65536").End(xlUp))
For Each c In Plage
If c.Offset(, 7) = "" Then
Sheets(c.Offset(, 1)).Select
with activesheet
.unprotect
derlig = .Range("A65536").End(xlUp).Row+1
for a = 0 to 7
.cells(derlig,a+1) = c.Offset(0, a).Value
next a
.protect
end with

Sheets("Saisie des écritures").Unprotect
c.Offset(, 7) = "X"
End If
Next c

Sheets("Saisie des écritures").Select
ActiveSheet.Unprotect
Range("A2:H60000").Select
selection.Sort key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("B2"), Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:= False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
Range("A4").Select
ActiveSheet.Protect
Sheets("INTERFACE").Select
End Sub

@+
FxM









Avatar
Philippe
Case "ADH001"
LigneADH001 = LigneADH001 + 1
Appelcompilation Sheets("ADH001"), c, LigneADH001 (me donne une
erreur de compilation : Type d'argument ByeRef incompatible






"MichDenis" a écrit dans le message de news:

Pourquoi ne pas modifier les "case" de ton Select Case
pour faire place à un appel d'une procédure qui va faire
la compilation....


Tu ajoutes la procédure suivante à la fin de ton module ...
'--------------------------------
Sub Appelcompilation(Sh As Worksheets, Cell As Range, Ligne As Long)

With Sh.Unprotect
.Select
.Range("A" & Ligne) = Cell.Value
.Range("B" & Ligne) = Cell.Offset(, 1).Value
.Range("C" & Ligne) = Cell.Offset(, 2).Value
.Range("D" & Ligne) = Cell.Offset(, 3).Value
.Range("E" & Ligne) = Cell.Offset(, 4).Value
.Range("F" & Ligne) = Cell.Offset(, 5).Value
.Range("G" & Ligne) = c.Offset(, 6).Value
.Protect
End Sub

End Sub
'--------------------------------

et tes cases de ton select case ressemblerait à ceci :

Case "ADH001"
LigneADH001 = LigneADH001 + 1
Appelcompilation Sheets("ADH001"), c, LigneADH001

Case "ADH001"
LigneADH001 = LigneADH002 + 1
Appelcompilation Sheets("ADH002"), c, LigneADH002

Non seulement ta procédure serait moins longue, mais tu augmenterait
la lisibilité de ton code ....


"Philippe" a écrit dans le message de news:
45545500$0$23507$
En fait ce programme fonctionnait telle quel pour ventiler sur les
feuilles
de ADH001 à ADH055 mais si j'atoute des lignes de code pour inclure ADH056
je plante avec erreur procédure trop longue 64 ko
Ce que je souhaite faire réellement dans ce classeur est de parcourir les
enregistrements de la feuille "Saisie des écritures" et la ou la croix "X"
n'est pas renseigné d' ajouter cette ligne dans la feuille correspondante
ADH..et de mettre une croix pour indiquer que cela était fait


"MichDenis" a écrit dans le message de news:

Le problème majeure avec la présentation de ta macro, C'est que les
plages
de cellules ne sont pas liées à une feuille particulière comme dans cet
exemple
relevé de ton code :

Set Plage = Range("A2", Range("A65536").End(xlUp))

à quelle feuille appartient Range("a2......)

Si tu appelles ta macro et que la feuille active n'est pas la "bonne",
ta
macro
va se planter ... Il est aussi très difficile de réécrire cette macro
sans
avoir
les références des feuilles auxquelles appartient les plages de cellules
....


"Philippe" a écrit dans le message de news:
455312af$0$5364$
Bonjoura tous,

Novice en Visual Basic, je souhaiterai votre aide
J' ai un classeur comportant plusieurs feuilles dont la principale
"Saisie
des écritures" est ventilé sur plusieurs feuilles de "ADH001" à "ADH150"
J'ai adapté le programme VB suivant


Private Sub CommandButton1_Click()

Dim c As Range, Plage As Range

Dim LigneA As Long, LigneB As Long, LigneC As Long

LigneADH001 = Sheets("ADH001").Range("A65536").End(xlUp).Row

LigneADH002 = Sheets("ADH002").Range("A65536").End(xlUp).Row

Set Plage = Range("A2", Range("A65536").End(xlUp))

For Each c In Plage

If c.Offset(, 7) = "" Then

Select Case c.Offset(, 1)

Case "ADH001"

Sheets("ADH001").Select

ActiveSheet.Unprotect

LigneADH001 = LigneADH001 + 1

Sheets("ADH001").Range("A" & LigneADH001) = c.Value

Sheets("ADH001").Range("B" & LigneADH001) = c.Offset(,
1).Value

Sheets("ADH001").Range("C" & LigneADH001) = c.Offset(,
2).Value

Sheets("ADH001").Range("D" & LigneADH001) = c.Offset(,
3).Value

Sheets("ADH001").Range("E" & LigneADH001) = c.Offset(,
4).Value

Sheets("ADH001").Range("F" & LigneADH001) = c.Offset(,
5).Value

Sheets("ADH001").Range("G" & LigneADH001) = c.Offset(,
6).Value

Sheets("ADH001").Select

ActiveSheet.Protect

Case "ADH002"

Sheets("ADH002").Unprotect

LigneADH002 = LigneADH002 + 1

Sheets("ADH002").Range("A" & LigneADH002) = c.Value

Sheets("ADH002").Range("B" & LigneADH002) = c.Offset(,
1).Value

Sheets("ADH002").Range("C" & LigneADH002) = c.Offset(,
2).Value

Sheets("ADH002").Range("D" & LigneADH002) = c.Offset(,
3).Value

Sheets("ADH002").Range("E" & LigneADH002) = c.Offset(,
4).Value

Sheets("ADH002").Range("F" & LigneADH002) = c.Offset(,
5).Value

Sheets("ADH002").Range("G" & LigneADH002) = c.Offset(,
6).Value

Sheets("ADH002").Protect

End Select

Sheets("Saisie des écritures").Unprotect

c.Offset(, 7) = "X"

End If

Next c

Sheets("Saisie des écritures").Select

ActiveSheet.Unprotect

Range("A2:H60000").Select

Selection.Sort key1:=Range("A2"), Order1:=xlAscending,
Key2:=Range("B2")
_

, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase: >> _

False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _

:=xlSortNormal

Range("A4").Select

ActiveSheet.Protect

Sheets("INTERFACE").Select

End Sub

Sub Accueil()

'

' Accueil Macro

' Macro enregistrée le 02/11/2006 par Philippe





Je peux ventiler les écritures jusqu'à la feuille "ADH065"

après je suis confronté a une erreur de compilation "procédure trop
longue"



Pouvez vous me venir en aide



Merci d'avance



Philippe


















Avatar
MichDenis
La procédure devrait se lire de la façon suivante :


Sub Appelcompilation(Sh As Worksheets, Cell As Range, Ligne As Long)

With Sh
.Select
.Unprotect
.Range("A" & Ligne) = Cell.Value
.Range("B" & Ligne) = Cell.Offset(, 1).Value
.Range("C" & Ligne) = Cell.Offset(, 2).Value
.Range("D" & Ligne) = Cell.Offset(, 3).Value
.Range("E" & Ligne) = Cell.Offset(, 4).Value
.Range("F" & Ligne) = Cell.Offset(, 5).Value
.Range("G" & Ligne) = c.Offset(, 6).Value
.Protect
End Sub

End Sub




"Philippe" a écrit dans le message de news:
45557805$0$3990$
Case "ADH001"
LigneADH001 = LigneADH001 + 1
Appelcompilation Sheets("ADH001"), c, LigneADH001 (me donne une
erreur de compilation : Type d'argument ByeRef incompatible






"MichDenis" a écrit dans le message de news:

Pourquoi ne pas modifier les "case" de ton Select Case
pour faire place à un appel d'une procédure qui va faire
la compilation....


Tu ajoutes la procédure suivante à la fin de ton module ...
'--------------------------------
Sub Appelcompilation(Sh As Worksheets, Cell As Range, Ligne As Long)

With Sh.Unprotect
.Select
.Range("A" & Ligne) = Cell.Value
.Range("B" & Ligne) = Cell.Offset(, 1).Value
.Range("C" & Ligne) = Cell.Offset(, 2).Value
.Range("D" & Ligne) = Cell.Offset(, 3).Value
.Range("E" & Ligne) = Cell.Offset(, 4).Value
.Range("F" & Ligne) = Cell.Offset(, 5).Value
.Range("G" & Ligne) = c.Offset(, 6).Value
.Protect
End Sub

End Sub
'--------------------------------

et tes cases de ton select case ressemblerait à ceci :

Case "ADH001"
LigneADH001 = LigneADH001 + 1
Appelcompilation Sheets("ADH001"), c, LigneADH001

Case "ADH001"
LigneADH001 = LigneADH002 + 1
Appelcompilation Sheets("ADH002"), c, LigneADH002

Non seulement ta procédure serait moins longue, mais tu augmenterait
la lisibilité de ton code ....


"Philippe" a écrit dans le message de news:
45545500$0$23507$
En fait ce programme fonctionnait telle quel pour ventiler sur les
feuilles
de ADH001 à ADH055 mais si j'atoute des lignes de code pour inclure ADH056
je plante avec erreur procédure trop longue 64 ko
Ce que je souhaite faire réellement dans ce classeur est de parcourir les
enregistrements de la feuille "Saisie des écritures" et la ou la croix "X"
n'est pas renseigné d' ajouter cette ligne dans la feuille correspondante
ADH..et de mettre une croix pour indiquer que cela était fait


"MichDenis" a écrit dans le message de news:

Le problème majeure avec la présentation de ta macro, C'est que les
plages
de cellules ne sont pas liées à une feuille particulière comme dans cet
exemple
relevé de ton code :

Set Plage = Range("A2", Range("A65536").End(xlUp))

à quelle feuille appartient Range("a2......)

Si tu appelles ta macro et que la feuille active n'est pas la "bonne",
ta
macro
va se planter ... Il est aussi très difficile de réécrire cette macro
sans
avoir
les références des feuilles auxquelles appartient les plages de cellules
....


"Philippe" a écrit dans le message de news:
455312af$0$5364$
Bonjoura tous,

Novice en Visual Basic, je souhaiterai votre aide
J' ai un classeur comportant plusieurs feuilles dont la principale
"Saisie
des écritures" est ventilé sur plusieurs feuilles de "ADH001" à "ADH150"
J'ai adapté le programme VB suivant


Private Sub CommandButton1_Click()

Dim c As Range, Plage As Range

Dim LigneA As Long, LigneB As Long, LigneC As Long

LigneADH001 = Sheets("ADH001").Range("A65536").End(xlUp).Row

LigneADH002 = Sheets("ADH002").Range("A65536").End(xlUp).Row

Set Plage = Range("A2", Range("A65536").End(xlUp))

For Each c In Plage

If c.Offset(, 7) = "" Then

Select Case c.Offset(, 1)

Case "ADH001"

Sheets("ADH001").Select

ActiveSheet.Unprotect

LigneADH001 = LigneADH001 + 1

Sheets("ADH001").Range("A" & LigneADH001) = c.Value

Sheets("ADH001").Range("B" & LigneADH001) = c.Offset(,
1).Value

Sheets("ADH001").Range("C" & LigneADH001) = c.Offset(,
2).Value

Sheets("ADH001").Range("D" & LigneADH001) = c.Offset(,
3).Value

Sheets("ADH001").Range("E" & LigneADH001) = c.Offset(,
4).Value

Sheets("ADH001").Range("F" & LigneADH001) = c.Offset(,
5).Value

Sheets("ADH001").Range("G" & LigneADH001) = c.Offset(,
6).Value

Sheets("ADH001").Select

ActiveSheet.Protect

Case "ADH002"

Sheets("ADH002").Unprotect

LigneADH002 = LigneADH002 + 1

Sheets("ADH002").Range("A" & LigneADH002) = c.Value

Sheets("ADH002").Range("B" & LigneADH002) = c.Offset(,
1).Value

Sheets("ADH002").Range("C" & LigneADH002) = c.Offset(,
2).Value

Sheets("ADH002").Range("D" & LigneADH002) = c.Offset(,
3).Value

Sheets("ADH002").Range("E" & LigneADH002) = c.Offset(,
4).Value

Sheets("ADH002").Range("F" & LigneADH002) = c.Offset(,
5).Value

Sheets("ADH002").Range("G" & LigneADH002) = c.Offset(,
6).Value

Sheets("ADH002").Protect

End Select

Sheets("Saisie des écritures").Unprotect

c.Offset(, 7) = "X"

End If

Next c

Sheets("Saisie des écritures").Select

ActiveSheet.Unprotect

Range("A2:H60000").Select

Selection.Sort key1:=Range("A2"), Order1:=xlAscending,
Key2:=Range("B2")
_

, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase: >> _

False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _

:=xlSortNormal

Range("A4").Select

ActiveSheet.Protect

Sheets("INTERFACE").Select

End Sub

Sub Accueil()

'

' Accueil Macro

' Macro enregistrée le 02/11/2006 par Philippe





Je peux ventiler les écritures jusqu'à la feuille "ADH065"

après je suis confronté a une erreur de compilation "procédure trop
longue"



Pouvez vous me venir en aide



Merci d'avance



Philippe


















Avatar
Philippe
Case "ADH001"
LigneADH001 = LigneADH001 + 1
Appelcompilation Sheets("ADH001"), c, LigneADH001 (me donne une
erreur de compilation : Type d'argument ByeRef incompatible



"MichDenis" a écrit dans le message de news:

La procédure devrait se lire de la façon suivante :


Sub Appelcompilation(Sh As Worksheets, Cell As Range, Ligne As Long)

With Sh
.Select
.Unprotect
.Range("A" & Ligne) = Cell.Value
.Range("B" & Ligne) = Cell.Offset(, 1).Value
.Range("C" & Ligne) = Cell.Offset(, 2).Value
.Range("D" & Ligne) = Cell.Offset(, 3).Value
.Range("E" & Ligne) = Cell.Offset(, 4).Value
.Range("F" & Ligne) = Cell.Offset(, 5).Value
.Range("G" & Ligne) = c.Offset(, 6).Value
.Protect
End Sub

End Sub




"Philippe" a écrit dans le message de news:
45557805$0$3990$
Case "ADH001"
LigneADH001 = LigneADH001 + 1
Appelcompilation Sheets("ADH001"), c, LigneADH001 (me donne une
erreur de compilation : Type d'argument ByeRef incompatible






"MichDenis" a écrit dans le message de news:

Pourquoi ne pas modifier les "case" de ton Select Case
pour faire place à un appel d'une procédure qui va faire
la compilation....


Tu ajoutes la procédure suivante à la fin de ton module ...
'--------------------------------
Sub Appelcompilation(Sh As Worksheets, Cell As Range, Ligne As Long)

With Sh.Unprotect
.Select
.Range("A" & Ligne) = Cell.Value
.Range("B" & Ligne) = Cell.Offset(, 1).Value
.Range("C" & Ligne) = Cell.Offset(, 2).Value
.Range("D" & Ligne) = Cell.Offset(, 3).Value
.Range("E" & Ligne) = Cell.Offset(, 4).Value
.Range("F" & Ligne) = Cell.Offset(, 5).Value
.Range("G" & Ligne) = c.Offset(, 6).Value
.Protect
End Sub

End Sub
'--------------------------------

et tes cases de ton select case ressemblerait à ceci :

Case "ADH001"
LigneADH001 = LigneADH001 + 1
Appelcompilation Sheets("ADH001"), c, LigneADH001

Case "ADH001"
LigneADH001 = LigneADH002 + 1
Appelcompilation Sheets("ADH002"), c, LigneADH002

Non seulement ta procédure serait moins longue, mais tu augmenterait
la lisibilité de ton code ....


"Philippe" a écrit dans le message de news:
45545500$0$23507$
En fait ce programme fonctionnait telle quel pour ventiler sur les
feuilles
de ADH001 à ADH055 mais si j'atoute des lignes de code pour inclure
ADH056
je plante avec erreur procédure trop longue 64 ko
Ce que je souhaite faire réellement dans ce classeur est de parcourir les
enregistrements de la feuille "Saisie des écritures" et la ou la croix
"X"
n'est pas renseigné d' ajouter cette ligne dans la feuille correspondante
ADH..et de mettre une croix pour indiquer que cela était fait


"MichDenis" a écrit dans le message de news:

Le problème majeure avec la présentation de ta macro, C'est que les
plages
de cellules ne sont pas liées à une feuille particulière comme dans cet
exemple
relevé de ton code :

Set Plage = Range("A2", Range("A65536").End(xlUp))

à quelle feuille appartient Range("a2......)

Si tu appelles ta macro et que la feuille active n'est pas la "bonne",
ta
macro
va se planter ... Il est aussi très difficile de réécrire cette macro
sans
avoir
les références des feuilles auxquelles appartient les plages de cellules
....


"Philippe" a écrit dans le message de news:
455312af$0$5364$
Bonjoura tous,

Novice en Visual Basic, je souhaiterai votre aide
J' ai un classeur comportant plusieurs feuilles dont la principale
"Saisie
des écritures" est ventilé sur plusieurs feuilles de "ADH001" à
"ADH150"
J'ai adapté le programme VB suivant


Private Sub CommandButton1_Click()

Dim c As Range, Plage As Range

Dim LigneA As Long, LigneB As Long, LigneC As Long

LigneADH001 = Sheets("ADH001").Range("A65536").End(xlUp).Row

LigneADH002 = Sheets("ADH002").Range("A65536").End(xlUp).Row

Set Plage = Range("A2", Range("A65536").End(xlUp))

For Each c In Plage

If c.Offset(, 7) = "" Then

Select Case c.Offset(, 1)

Case "ADH001"

Sheets("ADH001").Select

ActiveSheet.Unprotect

LigneADH001 = LigneADH001 + 1

Sheets("ADH001").Range("A" & LigneADH001) = c.Value

Sheets("ADH001").Range("B" & LigneADH001) = c.Offset(,
1).Value

Sheets("ADH001").Range("C" & LigneADH001) = c.Offset(,
2).Value

Sheets("ADH001").Range("D" & LigneADH001) = c.Offset(,
3).Value

Sheets("ADH001").Range("E" & LigneADH001) = c.Offset(,
4).Value

Sheets("ADH001").Range("F" & LigneADH001) = c.Offset(,
5).Value

Sheets("ADH001").Range("G" & LigneADH001) = c.Offset(,
6).Value

Sheets("ADH001").Select

ActiveSheet.Protect

Case "ADH002"

Sheets("ADH002").Unprotect

LigneADH002 = LigneADH002 + 1

Sheets("ADH002").Range("A" & LigneADH002) = c.Value

Sheets("ADH002").Range("B" & LigneADH002) = c.Offset(,
1).Value

Sheets("ADH002").Range("C" & LigneADH002) = c.Offset(,
2).Value

Sheets("ADH002").Range("D" & LigneADH002) = c.Offset(,
3).Value

Sheets("ADH002").Range("E" & LigneADH002) = c.Offset(,
4).Value

Sheets("ADH002").Range("F" & LigneADH002) = c.Offset(,
5).Value

Sheets("ADH002").Range("G" & LigneADH002) = c.Offset(,
6).Value

Sheets("ADH002").Protect

End Select

Sheets("Saisie des écritures").Unprotect

c.Offset(, 7) = "X"

End If

Next c

Sheets("Saisie des écritures").Select

ActiveSheet.Unprotect

Range("A2:H60000").Select

Selection.Sort key1:=Range("A2"), Order1:=xlAscending,
Key2:=Range("B2")
_

, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase: >>> _

False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _

:=xlSortNormal

Range("A4").Select

ActiveSheet.Protect

Sheets("INTERFACE").Select

End Sub

Sub Accueil()

'

' Accueil Macro

' Macro enregistrée le 02/11/2006 par Philippe





Je peux ventiler les écritures jusqu'à la feuille "ADH065"

après je suis confronté a une erreur de compilation "procédure trop
longue"



Pouvez vous me venir en aide



Merci d'avance



Philippe























Avatar
FxM
Bonsoir,

Juste pour info, la macro s'est terminée comme suit.

@+
FxM



Private Sub CommandButton1_Click()

'définition des variables
Dim celle As Range, sht As Worksheet, derlig As Long

'avec la feuille active (celle du bouton)
With ActiveSheet

'pour (presque) chaque cellule en colonne A
For Each celle In .Range("A2", Range("A65536").End(xlUp))

'si la ligne est à ventiler (vide)
If .Cells(celle.Row, "H") = "" Then

'si le numéro d'adhérente (colonne B) debute par ADH
If UCase(Left(.Cells(celle.Row, "B"), 3)) = "ADH" Then

'vérifier que le feuille existe
'sht est la feuille de destination
Set sht = Sheets(.Cells(celle.Row, "B").Value2)

'si la feuille existe
If Not sht Is Nothing Then

'dernière ligne actuelle de la feuille destination
derlig = sht.Range("A65536").End(xlUp).Row

'déprotéger feuille destination
sht.Unprotect

'copier les cellules de A à G (copie des valeurs uniquement)
celle.Resize(1, 7).Copy '(1,7) = col A à G
sht.Range("A" & derlig + 1).PasteSpecial xlPasteValues

'marquer comme ventilé dans la feuille source
.Cells(celle.Row, "H") = "X"

'reprotéger feuille destination
sht.Protect

'si la feuille destination est absente
Else

'message ou autre chose
MsgBox "Problème de feuille :" & vbCrLf & "La feuille " &
.Cells(celle.Row, "B").Value2 & " est absente !"

End If
End If
End If
Next celle
End With

'rendre la mémoire des set...
Set sht = Nothing
End Sub




Pourrais-tu mettre ton fichier sur cjoint.com ou en bal perso:
7m8a9aafg9zpqq1 @ jetable.net (enlever les espaces)

@+
FxM



Re-Bonjour
Je ne suis pas plus avancé pour autant
Merci de votre aide
Philippe

"FxM" a écrit dans le message de news:

Cette ligne est la généralisation de :
Select Case c.Offset(, 1)
Case "ADH001"
Sheets("ADH001").Select
équivalent à : si c.offset(,1)="ADH001" alors feuille("ADH001").select

Se pourrait-il que certains c.offset(0,1) ne correspondent pas à un
nom de feuille ? L'équivalent d'un "case else" en quelque sorte.

@+
FxM





Re Bonjour
Dans les 2 programmes essayés j'ai l'ereur "Sheets(c.Offset(,
1)).Select"

"FxM" a écrit dans le message de news:
%
Voire même : (déplacement de la détection de dernière ligne)

Non testé :
Private Sub CommandButton1_Click()
Dim c As Range, Plage As Range, a as integer
Dim derlig as long

Set Plage = Range("A2", Range("A65536").End(xlUp))
For Each c In Plage
If c.Offset(, 7) = "" Then
Sheets(c.Offset(, 1)).Select
with activesheet
.unprotect
derlig = .Range("A65536").End(xlUp).Row+1
for a = 0 to 7
.cells(derlig,a+1) = c.Offset(0, a).Value
next a
.protect
end with

Sheets("Saisie des écritures").Unprotect
c.Offset(, 7) = "X"
End If
Next c

Sheets("Saisie des écritures").Select
ActiveSheet.Unprotect
Range("A2:H60000").Select
selection.Sort key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("B2"), Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:= False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
Range("A4").Select
ActiveSheet.Protect
Sheets("INTERFACE").Select
End Sub

@+
FxM











1 2