copie de certaines données d'une page à une autre

SVP pouvez-vous m'aider?
--
Un gros merci!

Voila mon problème,

J'ai une feuille qui se nomme planification et une autre qui se nomme série 30
Dans ma feuille planification je veux vérifier ligne par ligne si dans mes
colonnes comprises dans ma série 30 seulement, il existe une cellule qui
n'est pas vide.

example: ("" = aucune donnée d'inscrite)
Feuille planification voici les colonnes appartenant à la série 30 (k, L,
M, N, O, V, W, AG, AH)

K4 = "" L4= "" M4="" N4= 15 O4= "" P4= 5 W4="" AH4= 10

AUSSITOT QU'IL RENCONTRE UNE DONNÉE NON VIDE dans la ligne, Les données
suivante devront ÊTRE COPIÉES DANS LA FEUILLE série 30 à une ligne qui devra
au dépard partir de 4 et s'incrémenter au fur et à mesure des copies, car
après une copie il devra refaire la même procédure pour la ligne suivante
dans la feuille planification et ce jusqu'à ce qu'il rencontre le critère 399
dans la colonne B de la dite feuille.

Voici les cellules qui devront être copiées:

de A4 à H4 et toutes les cellules mentionnées plus haut, en plus des deux
suivantes AD4 ET AE4

Est-ce que quelqu'un peut m'aider?

Un gros merci à l'avance

Bonjour,

Une solution en VBA.
Copiez le code ci-dessous dans un module standard du VBE.
ATTENTION: faites le test sur une copie de votre classeur.

Votre exposé contient des incohérences aussi d'éventuelles
corrections devront être apportées ?????
Feuille planification voici les colonnes appartenant à la série 30 (k,
L,
M, N, O, V, W, AG, AH)
K4 = "" L4= "" M4="" N4= 15 O4= "" P4= 5 W4="" AH4= 10
J'ai interprété la dernière ligne comme
K4 = "" L4= "" M4="" N4= 15 O4= "" V4= 5 W4="" AG4="" AH4= 10

Si je me suis trompé il faudra corriger les lignes de code
"!k1,l1,m1,n1,o1,v1,w1,ag1,ah1")
"!a1:h1,k1,l1,m1,n1,o1,v1,w1,ag1,ah1,ad1,ae1")
en modifiant les lettres (ce sont les colonnes) précisées impérativement
avec le "1" (c'est la première ligne IMPERATIVE)

'****************
Sub PMO_Planif2Serie()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim N1 As Name 'Bases
Dim N2 As Name 'A copier
Dim i&
Dim deb&
Dim fin&
Dim cible&
Dim bool As Boolean
Dim R As Range
Dim C As Range
On Error GoTo Erreur
Application.ScreenUpdating = False
With ActiveWorkbook
Set S1 = .Sheets("planification")
Set S2 = .Sheets("série 30")
S1.Select
Set N1 = .Names.Add(Name:="_pmoPlanif_", _
RefersTo:="=" & S1.Name & _
"!k1,l1,m1,n1,o1,v1,w1,ag1,ah1")
Set N2 = .Names.Add(Name:="_pmoAcopier_", _
RefersTo:="=" & S1.Name & _
"!a1:h1,k1,l1,m1,n1,o1,v1,w1,ag1,ah1,ad1,ae1")
End With
cible& = S2.UsedRange.Rows.Count + S2.UsedRange.Row
deb& = S1.UsedRange.Row
fin& = S1.UsedRange.Rows.Count
For i& = deb& To fin& + deb& - 1
If S1.Range("b" & i& & "") = 399 Then Exit For
S1.Select
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N1.Name
Set R = Range(Selection.Address)
bool = False
For Each C In R
If Not IsEmpty(C) Then
bool = True
Exit For
End If
Next C
If bool Then
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N2.Name
Selection.Copy
S2.Select
If cible& < 4 Then
cible& = 4
Else
cible& = cible& + 1
End If
Range("a" & cible& & "").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next i&
Erreur:
Application.ScreenUpdating = True
If Not N1 Is Nothing Then N1.Delete
If Not N2 Is Nothing Then N2.Delete
End Sub
'****************

Cordialement.

---
PMO
Patrick Morange

SVP pouvez-vous m'aider?
--
Un gros merci!

Voila mon problème,

J'ai une feuille qui se nomme planification et une autre qui se nomme série 30
Dans ma feuille planification je veux vérifier ligne par ligne si dans mes
colonnes comprises dans ma série 30 seulement, il existe une cellule qui
n'est pas vide.

example: ("" = aucune donnée d'inscrite)
Feuille planification voici les colonnes appartenant à la série 30 (k, L,
M, N, O, V, W, AG, AH)

K4 = "" L4= "" M4="" N4= 15 O4= "" P4= 5 W4="" AH4= 10

AUSSITOT QU'IL RENCONTRE UNE DONNÉE NON VIDE dans la ligne, Les données
suivante devront ÊTRE COPIÉES DANS LA FEUILLE série 30 à une ligne qui devra
au dépard partir de 4 et s'incrémenter au fur et à mesure des copies, car
après une copie il devra refaire la même procédure pour la ligne suivante
dans la feuille planification et ce jusqu'à ce qu'il rencontre le critère 399
dans la colonne B de la dite feuille.

Voici les cellules qui devront être copiées:

de A4 à H4 et toutes les cellules mentionnées plus haut, en plus des deux
suivantes AD4 ET AE4

Est-ce que quelqu'un peut m'aider?

Un gros merci à l'avance

Merci, merci

Mais cela ne fonctionne pas, rien ne se passe. Effectivement j'avais fais
une erreur lors de ma demande... trop de fatigue probablement a essayer toute
sorte de chose pour y arriver.

Je vous donne quelques informations que j'ai oublié d'indiquer. Un bouton
est dans la feuille Serie 30 sur le quel on cliquera pour mettre à jour les
données, il faut donc tout effacer à partir de la ligne 4 dans cette feuille.
Dans la feuille Planification il faut aussi commencer la lecture à la ligne
4...

Voici le code que j'ai modifié pour lire les bonnes choses... selon moi...
J'ai ajouté un i=4, c'est peut-être cela qui ne marche pas... et j'ai changé
les 1 pour 4 dans la série à lire et copier. Je ne suis pas vraiment bonne en
programmation, donc je ne réussie pas à trouver le bobo. Pouvez-vous encore
m'aider?

Sub PMO_Planif2Serie()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim N1 As Name 'Bases
Dim N2 As Name 'A copier
Dim i&
Dim deb&
Dim fin&
Dim cible&
Dim bool As Boolean
Dim R As Range
Dim C As Range

i = 4
On Error GoTo Erreur
Application.ScreenUpdating = False
With ActiveWorkbook
Set S1 = .Sheets("Planification")
Set S2 = .Sheets("Serie 30")
S1.Select
Set N1 = .Names.Add(Name:="_pmoPlanif_", _
RefersTo:="=" & S1.Name & _
"!k4:p4,v4,w4")
Set N2 = .Names.Add(Name:="_pmoAcopier_", _
RefersTo:="=" & S1.Name & _
"!a4:h4,k4:p4,v4,w4,ad4,ae4")
End With
cible& = S2.UsedRange.Rows.Count + S2.UsedRange.Row
deb& = S1.UsedRange.Row
fin& = S1.UsedRange.Rows.Count
For i& = deb& To fin& + deb& - 1
If S1.Range("b" & i& & "") = 399 Then Exit For
S1.Select
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N1.Name
Set R = Range(Selection.Address)
bool = False
For Each C In R
If Not IsEmpty(C) Then
bool = True
Exit For
End If
Next C
If bool Then
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N2.Name
Selection.Copy
S2.Select
If cible& < 4 Then
cible& = 4
Else
cible& = cible& + 1
End If
Range("a" & cible& & "").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next i&
Erreur:
Application.ScreenUpdating = True
If Not N1 Is Nothing Then N1.Delete
If Not N2 Is Nothing Then N2.Delete
End Sub

--
Un gros merci!

Bonjour,

Une solution en VBA.
Copiez le code ci-dessous dans un module standard du VBE.
ATTENTION: faites le test sur une copie de votre classeur.

Votre exposé contient des incohérences aussi d'éventuelles
corrections devront être apportées ?????
Feuille planification voici les colonnes appartenant à la série 30 (k,
L,
M, N, O, V, W, AG, AH)
K4 = "" L4= "" M4="" N4= 15 O4= "" P4= 5 W4="" AH4= 10
J'ai interprété la dernière ligne comme
K4 = "" L4= "" M4="" N4= 15 O4= "" V4= 5 W4="" AG4="" AH4= 10

Si je me suis trompé il faudra corriger les lignes de code
"!k1,l1,m1,n1,o1,v1,w1,ag1,ah1")
"!a1:h1,k1,l1,m1,n1,o1,v1,w1,ag1,ah1,ad1,ae1")
en modifiant les lettres (ce sont les colonnes) précisées impérativement
avec le "1" (c'est la première ligne IMPERATIVE)

'****************
Sub PMO_Planif2Serie()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim N1 As Name 'Bases
Dim N2 As Name 'A copier
Dim i&
Dim deb&
Dim fin&
Dim cible&
Dim bool As Boolean
Dim R As Range
Dim C As Range
On Error GoTo Erreur
Application.ScreenUpdating = False
With ActiveWorkbook
Set S1 = .Sheets("planification")
Set S2 = .Sheets("série 30")
S1.Select
Set N1 = .Names.Add(Name:="_pmoPlanif_", _
RefersTo:="=" & S1.Name & _
"!k1,l1,m1,n1,o1,v1,w1,ag1,ah1")
Set N2 = .Names.Add(Name:="_pmoAcopier_", _
RefersTo:="=" & S1.Name & _
"!a1:h1,k1,l1,m1,n1,o1,v1,w1,ag1,ah1,ad1,ae1")
End With
cible& = S2.UsedRange.Rows.Count + S2.UsedRange.Row
deb& = S1.UsedRange.Row
fin& = S1.UsedRange.Rows.Count
For i& = deb& To fin& + deb& - 1
If S1.Range("b" & i& & "") = 399 Then Exit For
S1.Select
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N1.Name
Set R = Range(Selection.Address)
bool = False
For Each C In R
If Not IsEmpty(C) Then
bool = True
Exit For
End If
Next C
If bool Then
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N2.Name
Selection.Copy
S2.Select
If cible& < 4 Then
cible& = 4
Else
cible& = cible& + 1
End If
Range("a" & cible& & "").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next i&
Erreur:
Application.ScreenUpdating = True
If Not N1 Is Nothing Then N1.Delete
If Not N2 Is Nothing Then N2.Delete
End Sub
'****************

Cordialement.

---
PMO
Patrick Morange

SVP pouvez-vous m'aider?
--
Un gros merci!

Voila mon problème,

J'ai une feuille qui se nomme planification et une autre qui se nomme série 30
Dans ma feuille planification je veux vérifier ligne par ligne si dans mes
colonnes comprises dans ma série 30 seulement, il existe une cellule qui
n'est pas vide.

example: ("" = aucune donnée d'inscrite)
Feuille planification voici les colonnes appartenant à la série 30 (k, L,
M, N, O, V, W, AG, AH)

K4 = "" L4= "" M4="" N4= 15 O4= "" P4= 5 W4="" AH4= 10

AUSSITOT QU'IL RENCONTRE UNE DONNÉE NON VIDE dans la ligne, Les données
suivante devront ÊTRE COPIÉES DANS LA FEUILLE série 30 à une ligne qui devra
au dépard partir de 4 et s'incrémenter au fur et à mesure des copies, car
après une copie il devra refaire la même procédure pour la ligne suivante
dans la feuille planification et ce jusqu'à ce qu'il rencontre le critère 399
dans la colonne B de la dite feuille.

Voici les cellules qui devront être copiées:

de A4 à H4 et toutes les cellules mentionnées plus haut, en plus des deux
suivantes AD4 ET AE4

Est-ce que quelqu'un peut m'aider?

Un gros merci à l'avance

Bonjour,

J'ai écrit dans mon dernier courrier:
précisées impérativement avec le "1" (c'est la première ligne IMPERATIVE)
Cela signifie qu'il faut toujours LAISSER 1 et pas autre chose.

Le mieux serait que vous m'adressiez votre classeur (dans la mesure
où sa confidentialité n'est pas rédhibitoire) à l'adresse suivante et en
ayant
préalablement changer AT par @ et PAYS par fr (à cause des spams):
patrick.morangeATinterstat.PAYS

Cordialement.
--
PMO
Patrick Morange

Merci, merci

Mais cela ne fonctionne pas, rien ne se passe. Effectivement j'avais fais
une erreur lors de ma demande... trop de fatigue probablement a essayer toute
sorte de chose pour y arriver.

Je vous donne quelques informations que j'ai oublié d'indiquer. Un bouton
est dans la feuille Serie 30 sur le quel on cliquera pour mettre à jour les
données, il faut donc tout effacer à partir de la ligne 4 dans cette feuille.
Dans la feuille Planification il faut aussi commencer la lecture à la ligne
4...

Voici le code que j'ai modifié pour lire les bonnes choses... selon moi...
J'ai ajouté un i=4, c'est peut-être cela qui ne marche pas... et j'ai changé
les 1 pour 4 dans la série à lire et copier. Je ne suis pas vraiment bonne en
programmation, donc je ne réussie pas à trouver le bobo. Pouvez-vous encore
m'aider?

Sub PMO_Planif2Serie()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim N1 As Name 'Bases
Dim N2 As Name 'A copier
Dim i&
Dim deb&
Dim fin&
Dim cible&
Dim bool As Boolean
Dim R As Range
Dim C As Range

i = 4
On Error GoTo Erreur
Application.ScreenUpdating = False
With ActiveWorkbook
Set S1 = .Sheets("Planification")
Set S2 = .Sheets("Serie 30")
S1.Select
Set N1 = .Names.Add(Name:="_pmoPlanif_", _
RefersTo:="=" & S1.Name & _
"!k4:p4,v4,w4")
Set N2 = .Names.Add(Name:="_pmoAcopier_", _
RefersTo:="=" & S1.Name & _
"!a4:h4,k4:p4,v4,w4,ad4,ae4")
End With
cible& = S2.UsedRange.Rows.Count + S2.UsedRange.Row
deb& = S1.UsedRange.Row
fin& = S1.UsedRange.Rows.Count
For i& = deb& To fin& + deb& - 1
If S1.Range("b" & i& & "") = 399 Then Exit For
S1.Select
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N1.Name
Set R = Range(Selection.Address)
bool = False
For Each C In R
If Not IsEmpty(C) Then
bool = True
Exit For
End If
Next C
If bool Then
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N2.Name
Selection.Copy
S2.Select
If cible& < 4 Then
cible& = 4
Else
cible& = cible& + 1
End If
Range("a" & cible& & "").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next i&
Erreur:
Application.ScreenUpdating = True
If Not N1 Is Nothing Then N1.Delete
If Not N2 Is Nothing Then N2.Delete
End Sub

--
Un gros merci!

Bonjour,

Une solution en VBA.
Copiez le code ci-dessous dans un module standard du VBE.
ATTENTION: faites le test sur une copie de votre classeur.

Votre exposé contient des incohérences aussi d'éventuelles
corrections devront être apportées ?????
Feuille planification voici les colonnes appartenant à la série 30 (k,
L,
M, N, O, V, W, AG, AH)
K4 = "" L4= "" M4="" N4= 15 O4= "" P4= 5 W4="" AH4= 10
J'ai interprété la dernière ligne comme
K4 = "" L4= "" M4="" N4= 15 O4= "" V4= 5 W4="" AG4="" AH4= 10

Si je me suis trompé il faudra corriger les lignes de code
"!k1,l1,m1,n1,o1,v1,w1,ag1,ah1")
"!a1:h1,k1,l1,m1,n1,o1,v1,w1,ag1,ah1,ad1,ae1")
en modifiant les lettres (ce sont les colonnes) précisées impérativement
avec le "1" (c'est la première ligne IMPERATIVE)

'****************
Sub PMO_Planif2Serie()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim N1 As Name 'Bases
Dim N2 As Name 'A copier
Dim i&
Dim deb&
Dim fin&
Dim cible&
Dim bool As Boolean
Dim R As Range
Dim C As Range
On Error GoTo Erreur
Application.ScreenUpdating = False
With ActiveWorkbook
Set S1 = .Sheets("planification")
Set S2 = .Sheets("série 30")
S1.Select
Set N1 = .Names.Add(Name:="_pmoPlanif_", _
RefersTo:="=" & S1.Name & _
"!k1,l1,m1,n1,o1,v1,w1,ag1,ah1")
Set N2 = .Names.Add(Name:="_pmoAcopier_", _
RefersTo:="=" & S1.Name & _
"!a1:h1,k1,l1,m1,n1,o1,v1,w1,ag1,ah1,ad1,ae1")
End With
cible& = S2.UsedRange.Rows.Count + S2.UsedRange.Row
deb& = S1.UsedRange.Row
fin& = S1.UsedRange.Rows.Count
For i& = deb& To fin& + deb& - 1
If S1.Range("b" & i& & "") = 399 Then Exit For
S1.Select
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N1.Name
Set R = Range(Selection.Address)
bool = False
For Each C In R
If Not IsEmpty(C) Then
bool = True
Exit For
End If
Next C
If bool Then
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N2.Name
Selection.Copy
S2.Select
If cible& < 4 Then
cible& = 4
Else
cible& = cible& + 1
End If
Range("a" & cible& & "").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next i&
Erreur:
Application.ScreenUpdating = True
If Not N1 Is Nothing Then N1.Delete
If Not N2 Is Nothing Then N2.Delete
End Sub
'****************

Cordialement.

---
PMO
Patrick Morange

SVP pouvez-vous m'aider?
--
Un gros merci!

Voila mon problème,

J'ai une feuille qui se nomme planification et une autre qui se nomme série 30
Dans ma feuille planification je veux vérifier ligne par ligne si dans mes
colonnes comprises dans ma série 30 seulement, il existe une cellule qui
n'est pas vide.

example: ("" = aucune donnée d'inscrite)
Feuille planification voici les colonnes appartenant à la série 30 (k, L,
M, N, O, V, W, AG, AH)

K4 = "" L4= "" M4="" N4= 15 O4= "" P4= 5 W4="" AH4= 10

AUSSITOT QU'IL RENCONTRE UNE DONNÉE NON VIDE dans la ligne, Les données
suivante devront ÊTRE COPIÉES DANS LA FEUILLE série 30 à une ligne qui devra
au dépard partir de 4 et s'incrémenter au fur et à mesure des copies, car
après une copie il devra refaire la même procédure pour la ligne suivante
dans la feuille planification et ce jusqu'à ce qu'il rencontre le critère 399
dans la colonne B de la dite feuille.

Voici les cellules qui devront être copiées:

de A4 à H4 et toutes les cellules mentionnées plus haut, en plus des deux
suivantes AD4 ET AE4

Est-ce que quelqu'un peut m'aider?

Un gros merci à l'avance

J'essaie votre adresse de courriel, mais mon message revient avec cette note

Delivery to the following recipients failed.

J'ai bien fait le changement que vous m'avez indiqué dans l'adresse.

Merci


--
Un gros merci!

Bonjour,

J'ai écrit dans mon dernier courrier:
précisées impérativement avec le "1" (c'est la première ligne IMPERATIVE)
Cela signifie qu'il faut toujours LAISSER 1 et pas autre chose.

Le mieux serait que vous m'adressiez votre classeur (dans la mesure
où sa confidentialité n'est pas rédhibitoire) à l'adresse suivante et en
ayant
préalablement changer AT par @ et PAYS par fr (à cause des spams):
patrick.morangeATinterstat.PAYS

Cordialement.
--
PMO
Patrick Morange

Merci, merci

Mais cela ne fonctionne pas, rien ne se passe. Effectivement j'avais fais
une erreur lors de ma demande... trop de fatigue probablement a essayer toute
sorte de chose pour y arriver.

Je vous donne quelques informations que j'ai oublié d'indiquer. Un bouton
est dans la feuille Serie 30 sur le quel on cliquera pour mettre à jour les
données, il faut donc tout effacer à partir de la ligne 4 dans cette feuille.
Dans la feuille Planification il faut aussi commencer la lecture à la ligne
4...

Voici le code que j'ai modifié pour lire les bonnes choses... selon moi...
J'ai ajouté un i=4, c'est peut-être cela qui ne marche pas... et j'ai changé
les 1 pour 4 dans la série à lire et copier. Je ne suis pas vraiment bonne en
programmation, donc je ne réussie pas à trouver le bobo. Pouvez-vous encore
m'aider?

Sub PMO_Planif2Serie()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim N1 As Name 'Bases
Dim N2 As Name 'A copier
Dim i&
Dim deb&
Dim fin&
Dim cible&
Dim bool As Boolean
Dim R As Range
Dim C As Range

i = 4
On Error GoTo Erreur
Application.ScreenUpdating = False
With ActiveWorkbook
Set S1 = .Sheets("Planification")
Set S2 = .Sheets("Serie 30")
S1.Select
Set N1 = .Names.Add(Name:="_pmoPlanif_", _
RefersTo:="=" & S1.Name & _
"!k4:p4,v4,w4")
Set N2 = .Names.Add(Name:="_pmoAcopier_", _
RefersTo:="=" & S1.Name & _
"!a4:h4,k4:p4,v4,w4,ad4,ae4")
End With
cible& = S2.UsedRange.Rows.Count + S2.UsedRange.Row
deb& = S1.UsedRange.Row
fin& = S1.UsedRange.Rows.Count
For i& = deb& To fin& + deb& - 1
If S1.Range("b" & i& & "") = 399 Then Exit For
S1.Select
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N1.Name
Set R = Range(Selection.Address)
bool = False
For Each C In R
If Not IsEmpty(C) Then
bool = True
Exit For
End If
Next C
If bool Then
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N2.Name
Selection.Copy
S2.Select
If cible& < 4 Then
cible& = 4
Else
cible& = cible& + 1
End If
Range("a" & cible& & "").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next i&
Erreur:
Application.ScreenUpdating = True
If Not N1 Is Nothing Then N1.Delete
If Not N2 Is Nothing Then N2.Delete
End Sub

--
Un gros merci!

Bonjour,

Une solution en VBA.
Copiez le code ci-dessous dans un module standard du VBE.
ATTENTION: faites le test sur une copie de votre classeur.

Votre exposé contient des incohérences aussi d'éventuelles
corrections devront être apportées ?????
Feuille planification voici les colonnes appartenant à la série 30 (k,
L,
M, N, O, V, W, AG, AH)
K4 = "" L4= "" M4="" N4= 15 O4= "" P4= 5 W4="" AH4= 10
J'ai interprété la dernière ligne comme
K4 = "" L4= "" M4="" N4= 15 O4= "" V4= 5 W4="" AG4="" AH4= 10

Si je me suis trompé il faudra corriger les lignes de code
"!k1,l1,m1,n1,o1,v1,w1,ag1,ah1")
"!a1:h1,k1,l1,m1,n1,o1,v1,w1,ag1,ah1,ad1,ae1")
en modifiant les lettres (ce sont les colonnes) précisées impérativement
avec le "1" (c'est la première ligne IMPERATIVE)

'****************
Sub PMO_Planif2Serie()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim N1 As Name 'Bases
Dim N2 As Name 'A copier
Dim i&
Dim deb&
Dim fin&
Dim cible&
Dim bool As Boolean
Dim R As Range
Dim C As Range
On Error GoTo Erreur
Application.ScreenUpdating = False
With ActiveWorkbook
Set S1 = .Sheets("planification")
Set S2 = .Sheets("série 30")
S1.Select
Set N1 = .Names.Add(Name:="_pmoPlanif_", _
RefersTo:="=" & S1.Name & _
"!k1,l1,m1,n1,o1,v1,w1,ag1,ah1")
Set N2 = .Names.Add(Name:="_pmoAcopier_", _
RefersTo:="=" & S1.Name & _
"!a1:h1,k1,l1,m1,n1,o1,v1,w1,ag1,ah1,ad1,ae1")
End With
cible& = S2.UsedRange.Rows.Count + S2.UsedRange.Row
deb& = S1.UsedRange.Row
fin& = S1.UsedRange.Rows.Count
For i& = deb& To fin& + deb& - 1
If S1.Range("b" & i& & "") = 399 Then Exit For
S1.Select
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N1.Name
Set R = Range(Selection.Address)
bool = False
For Each C In R
If Not IsEmpty(C) Then
bool = True
Exit For
End If
Next C
If bool Then
S1.Range("a" & i& & "").Select
Application.Goto Reference:=N2.Name
Selection.Copy
S2.Select
If cible& < 4 Then
cible& = 4
Else
cible& = cible& + 1
End If
Range("a" & cible& & "").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next i&
Erreur:
Application.ScreenUpdating = True
If Not N1 Is Nothing Then N1.Delete
If Not N2 Is Nothing Then N2.Delete
End Sub
'****************

Cordialement.

---
PMO
Patrick Morange

SVP pouvez-vous m'aider?
--
Un gros merci!

Voila mon problème,

J'ai une feuille qui se nomme planification et une autre qui se nomme série 30
Dans ma feuille planification je veux vérifier ligne par ligne si dans mes
colonnes comprises dans ma série 30 seulement, il existe une cellule qui
n'est pas vide.

example: ("" = aucune donnée d'inscrite)
Feuille planification voici les colonnes appartenant à la série 30 (k, L,
M, N, O, V, W, AG, AH)

K4 = "" L4= "" M4="" N4= 15 O4= "" P4= 5 W4="" AH4= 10

AUSSITOT QU'IL RENCONTRE UNE DONNÉE NON VIDE dans la ligne, Les données
suivante devront ÊTRE COPIÉES DANS LA FEUILLE série 30 à une ligne qui devra
au dépard partir de 4 et s'incrémenter au fur et à mesure des copies, car
après une copie il devra refaire la même procédure pour la ligne suivante
dans la feuille planification et ce jusqu'à ce qu'il rencontre le critère 399
dans la colonne B de la dite feuille.

Voici les cellules qui devront être copiées:

de A4 à H4 et toutes les cellules mentionnées plus haut, en plus des deux
suivantes AD4 ET AE4

Est-ce que quelqu'un peut m'aider?

Un gros merci à l'avance

Bonjour,

Décidément on ne va pas y arriver.
Essayez de joindre votre classeur par Cjoint.com

Cordialement.
--
PMO
Patrick Morange

J'essaie votre adresse de courriel, mais mon message revient avec cette note

Delivery to the following recipients failed.

J'ai bien fait le changement que vous m'avez indiqué dans l'adresse.

Merci

J'espère que ceci sera ok

http://cjoint.com/?gnvt1zr3uB
--
Un gros merci!

Bonjour,

Décidément on ne va pas y arriver.
Essayez de joindre votre classeur par Cjoint.com

Cordialement.
--
PMO
Patrick Morange

J'essaie votre adresse de courriel, mais mon message revient avec cette note

Delivery to the following recipients failed.

J'ai bien fait le changement que vous m'avez indiqué dans l'adresse.

Merci

Voici mon code que j'essaie désespérément de faire fonctionner, peut-être que
quelqu'un pourra m'aider...

Sub bouton_click()

Dim j As Integer
Dim k As Integer

Dim S1 As Worksheet
Dim S2 As Worksheet

Set S1 = Sheets("Planification")
Set S2 = Sheets("Serie 30")

Application.ScreenUpdating = False
'Je positionne ma sélection dans la feuille S1=Planification
S1.Range("A4").Select

k = 4

' Je définie la valeur de départ de j à 4 et je boucle jusqu'a la fin de la
page

For j = 4 To S1.Range("A65536").End(xlUp).Row

'je vérifie si la donnée de la colonne B à la ligne de la valeur j est
différente de 399 si oui je procède si non j'arrête.

If S1.Cells(j, 2).Value <> 399 Then

'Je vérifie si les cellules de la plage contiennent ou pas des
données

If S1.Range(("K" & j & ":" & "P" & j), ("V" & j & ":" & "W" &
j)).Value <> "" Then

'Je sélectionne les éléments à copier

S1.Range(("A" & j & ":" & "H" & j), ("k" & j & ":" & "P" & j),
("V" & j & ":" & "W" & j), ("AD" & j & ":" & "AE" & j)).Select
Selection.Copy

' je sélectionne la cellule (A,valeur de k)de la feuille
S2=Serie 30
S2.Cells(k, 1).Select

line1:
'Je vérifie si la cellule(k,1) de la feuille S2 est vide
If ActiveCell.Value = "" Then

' Je colle les données dans la feuille S2= Serie 30 les
données copiées de la feuille S1=Planification

S2.Range(("A" & k & ":" & "I" & k), ("k" & k & ":" & "P"
& k), ("K" & k), ("M" & k), ("O" & k), ("Q" & k), ("S" & k), ("U" & k), ("W"
& k), ("Y" & k), ("Z" & k)).Paste

' Je sélectionne la feuille S1=Planification
S1.Select
Else
'j'augmente la valeur de k de 1
k = k + 1

'Je sélection la cellule A de la prochaine ligne de la
feuille S2
S2.Range("A" & k).Select
'Je recommence ma vérification à partir de l'étiquette
line1
GoTo line1
End If
k = k + 1
Else
Next j
End If

Else
Exit Sub
End If
Next j

S2.Select
Application.ScreenUpdating = True
End Sub

Merci
--
Un gros merci!

Voila mon problème,

J'ai une feuille qui se nomme planification et une autre qui se nomme série 30
Dans ma feuille planification je veux vérifier ligne par ligne si dans mes
colonnes comprises dans ma série 30 seulement, il existe une cellule qui
n'est pas vide.

example: ("" = aucune donnée d'inscrite)
Feuille planification voici les colonnes appartenant à la série 30 (k, L,
M, N, O, V, W, AG, AH)

K4 = "" L4= "" M4="" N4= 15 O4= "" P4= 5 W4="" AH4= 10

AUSSITOT QU'IL RENCONTRE UNE DONNÉE NON VIDE dans la ligne, Les données
suivante devront ÊTRE COPIÉES DANS LA FEUILLE série 30 à une ligne qui devra
au dépard partir de 4 et s'incrémenter au fur et à mesure des copies, car
après une copie il devra refaire la même procédure pour la ligne suivante
dans la feuille planification et ce jusqu'à ce qu'il rencontre le critère 399
dans la colonne B de la dite feuille.

Voici les cellules qui devront être copiées:

de A4 à H4 et toutes les cellules mentionnées plus haut, en plus des deux
suivantes AD4 ET AE4

Est-ce que quelqu'un peut m'aider?

Un gros merci à l'avance

bonjour,

si tu indiquais où ca plante, ce serait pas mal.

Déjà, l'écriture d'une instruction S1.Range(("K" & j & ":" & "P" & j),
("V" & j & ":" & "W" &

j)).Value <> "" de ce type pose à priori problème

Par ailleurs, écrire S1.Range(("A" & j & ":" & "H" & j), ("k" & j & ":"
& "P" & j),
("V" & j & ":" & "W" & j), ("AD" & j & ":" & "AE" & j)).Select pose
forcément un problème de nombre d'arguments

Bon, ce sont de 1eres pistes parceque je n'ai pas lu tout le code.


A+

Voici mon code que j'essaie désespérément de faire fonctionner, peut-être que
quelqu'un pourra m'aider...

Sub bouton_click()

Dim j As Integer
Dim k As Integer

Dim S1 As Worksheet
Dim S2 As Worksheet

Set S1 = Sheets("Planification")
Set S2 = Sheets("Serie 30")

Application.ScreenUpdating = False
'Je positionne ma sélection dans la feuille S1=Planification
S1.Range("A4").Select

k = 4

' Je définie la valeur de départ de j à 4 et je boucle jusqu'a la fin de la
page

For j = 4 To S1.Range("A65536").End(xlUp).Row

'je vérifie si la donnée de la colonne B à la ligne de la valeur j est
différente de 399 si oui je procède si non j'arrête.

If S1.Cells(j, 2).Value <> 399 Then

'Je vérifie si les cellules de la plage contiennent ou pas des
données

If S1.Range(("K" & j & ":" & "P" & j), ("V" & j & ":" & "W" &
j)).Value <> "" Then

'Je sélectionne les éléments à copier

S1.Range(("A" & j & ":" & "H" & j), ("k" & j & ":" & "P" & j),
("V" & j & ":" & "W" & j), ("AD" & j & ":" & "AE" & j)).Select
Selection.Copy

' je sélectionne la cellule (A,valeur de k)de la feuille
S2=Serie 30
S2.Cells(k, 1).Select

line1:
'Je vérifie si la cellule(k,1) de la feuille S2 est vide
If ActiveCell.Value = "" Then

' Je colle les données dans la feuille S2= Serie 30 les
données copiées de la feuille S1=Planification

S2.Range(("A" & k & ":" & "I" & k), ("k" & k & ":" & "P"
& k), ("K" & k), ("M" & k), ("O" & k), ("Q" & k), ("S" & k), ("U" & k), ("W"
& k), ("Y" & k), ("Z" & k)).Paste

' Je sélectionne la feuille S1=Planification
S1.Select
Else
'j'augmente la valeur de k de 1
k = k + 1

'Je sélection la cellule A de la prochaine ligne de la
feuille S2
S2.Range("A" & k).Select
'Je recommence ma vérification à partir de l'étiquette
line1
GoTo line1
End If
k = k + 1
Else
Next j
End If

Else
Exit Sub
End If
Next j

S2.Select
Application.ScreenUpdating = True
End Sub

Merci