Bonjour FxM
La ta proc fonctionne (même sous Xl2K v.9.0.6926 SP3)
et je peux jongler avec les robinets pour adapter le champ sélectionné.
impeccable (les Wend de FL ont aussi l'air de faire leur boulot)PS : (je ne sais si on t'a dit, Morphée est ... un mec !)
Gaaaarrghhhh !
Personne me dit jamais rien!! :-[
@+
Je poursuis ma proc (dans la mesure des rares minutes que je pourrais
trouver aujourdhui, sinon ce soir à la maison)
Amicalement
JF
FxM wrote:Bonjour J@@ (Jean-François ?),
oui :-)Cette fois, testé sous Excel 2002 Fr (v10.2614.2625)
* je n'ai pas de problème avec le 'is nothing'
* pour ce qui est d'oublier la première ligne :
zone(1) est la première cellule de la zone,
zone(zone.cells.count) est la dernière,
- Reste à décaler le début -> prenons l'offset(1,0) de la première
cellule (donc la cellule juste en-dessous)
- il faut prendre les adresses et non les cellules et donc ajouter un
..address quelque part
Ce qui te donne (attention aux coupures de lignes) :
Sub test2()
Dim zone As Range
'une seule ligne
Set zone = Intersect(ActiveCell.CurrentRegion,
Range("B1:F1").EntireColumn)
If Not zone Is Nothing Then
'une seule ligne
Set zone = Range(zone(1).Offset(1, 0).Address,
zone(zone.Cells.Count).Address)
zone.Select
End If
End Sub
Fais une bise à Morphée si tu veux puis essaie ensuite :o)
@+
FxM
PS : (je ne sais si on t'a dit, Morphée est ... un mec !)
Bonjour FxM
La ta proc fonctionne (même sous Xl2K v.9.0.6926 SP3)
et je peux jongler avec les robinets pour adapter le champ sélectionné.
impeccable (les Wend de FL ont aussi l'air de faire leur boulot)
PS : (je ne sais si on t'a dit, Morphée est ... un mec !)
Gaaaarrghhhh !
Personne me dit jamais rien!! :-[
@+
Je poursuis ma proc (dans la mesure des rares minutes que je pourrais
trouver aujourdhui, sinon ce soir à la maison)
Amicalement
JF
FxM wrote:
Bonjour J@@ (Jean-François ?),
oui :-)
Cette fois, testé sous Excel 2002 Fr (v10.2614.2625)
* je n'ai pas de problème avec le 'is nothing'
* pour ce qui est d'oublier la première ligne :
zone(1) est la première cellule de la zone,
zone(zone.cells.count) est la dernière,
- Reste à décaler le début -> prenons l'offset(1,0) de la première
cellule (donc la cellule juste en-dessous)
- il faut prendre les adresses et non les cellules et donc ajouter un
..address quelque part
Ce qui te donne (attention aux coupures de lignes) :
Sub test2()
Dim zone As Range
'une seule ligne
Set zone = Intersect(ActiveCell.CurrentRegion,
Range("B1:F1").EntireColumn)
If Not zone Is Nothing Then
'une seule ligne
Set zone = Range(zone(1).Offset(1, 0).Address,
zone(zone.Cells.Count).Address)
zone.Select
End If
End Sub
Fais une bise à Morphée si tu veux puis essaie ensuite :o)
@+
FxM
PS : (je ne sais si on t'a dit, Morphée est ... un mec !)
Bonjour FxM
La ta proc fonctionne (même sous Xl2K v.9.0.6926 SP3)
et je peux jongler avec les robinets pour adapter le champ sélectionné.
impeccable (les Wend de FL ont aussi l'air de faire leur boulot)PS : (je ne sais si on t'a dit, Morphée est ... un mec !)
Gaaaarrghhhh !
Personne me dit jamais rien!! :-[
@+
Je poursuis ma proc (dans la mesure des rares minutes que je pourrais
trouver aujourdhui, sinon ce soir à la maison)
Amicalement
JF
FxM wrote:Bonjour J@@ (Jean-François ?),
oui :-)Cette fois, testé sous Excel 2002 Fr (v10.2614.2625)
* je n'ai pas de problème avec le 'is nothing'
* pour ce qui est d'oublier la première ligne :
zone(1) est la première cellule de la zone,
zone(zone.cells.count) est la dernière,
- Reste à décaler le début -> prenons l'offset(1,0) de la première
cellule (donc la cellule juste en-dessous)
- il faut prendre les adresses et non les cellules et donc ajouter un
..address quelque part
Ce qui te donne (attention aux coupures de lignes) :
Sub test2()
Dim zone As Range
'une seule ligne
Set zone = Intersect(ActiveCell.CurrentRegion,
Range("B1:F1").EntireColumn)
If Not zone Is Nothing Then
'une seule ligne
Set zone = Range(zone(1).Offset(1, 0).Address,
zone(zone.Cells.Count).Address)
zone.Select
End If
End Sub
Fais une bise à Morphée si tu veux puis essaie ensuite :o)
@+
FxM
PS : (je ne sais si on t'a dit, Morphée est ... un mec !)
dans le code, il fallait bien sûr initialiser i et j à 1,
Sub b()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
End If
Next ligne
End Sub
Cordialement
FL
dans le code, il fallait bien sûr initialiser i et j à 1,
Sub b()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
End If
Next ligne
End Sub
Cordialement
FL
dans le code, il fallait bien sûr initialiser i et j à 1,
Sub b()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
End If
Next ligne
End Sub
Cordialement
FL
Bonjour FL
merci pour le code, qui copie bien les données sur la feuille résultat.
En pratique, je souhaite :
Pour chaque classe
copier les données F puis M, mais dans les feuilles portant le nom des
classes,
et chaque ligne collée étant espacée de la précédente d'une ligne vierge.
Sinon, c'est bizarre le PasteSpecial xlValue que j'ai ajouté ne fonctionne
pas.
@+
cordialement
J@@
'***
Sub b1()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(4).Select
ActiveSheet.PasteSpecial xlValue
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.PasteSpecial xlValue
Sheets("liste_test").Select
End If
Next ligne
End Sub
'***
FL wrote:dans le code, il fallait bien sûr initialiser i et j à 1,
Sub b()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
End If
Next ligne
End Sub
Cordialement
FL
Bonjour FL
merci pour le code, qui copie bien les données sur la feuille résultat.
En pratique, je souhaite :
Pour chaque classe
copier les données F puis M, mais dans les feuilles portant le nom des
classes,
et chaque ligne collée étant espacée de la précédente d'une ligne vierge.
Sinon, c'est bizarre le PasteSpecial xlValue que j'ai ajouté ne fonctionne
pas.
@+
cordialement
J@@
'***
Sub b1()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(4).Select
ActiveSheet.PasteSpecial xlValue
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.PasteSpecial xlValue
Sheets("liste_test").Select
End If
Next ligne
End Sub
'***
FL wrote:
dans le code, il fallait bien sûr initialiser i et j à 1,
Sub b()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
End If
Next ligne
End Sub
Cordialement
FL
Bonjour FL
merci pour le code, qui copie bien les données sur la feuille résultat.
En pratique, je souhaite :
Pour chaque classe
copier les données F puis M, mais dans les feuilles portant le nom des
classes,
et chaque ligne collée étant espacée de la précédente d'une ligne vierge.
Sinon, c'est bizarre le PasteSpecial xlValue que j'ai ajouté ne fonctionne
pas.
@+
cordialement
J@@
'***
Sub b1()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(4).Select
ActiveSheet.PasteSpecial xlValue
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.PasteSpecial xlValue
Sheets("liste_test").Select
End If
Next ligne
End Sub
'***
FL wrote:dans le code, il fallait bien sûr initialiser i et j à 1,
Sub b()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
End If
Next ligne
End Sub
Cordialement
FL
Bonjour FL
merci pour le code, qui copie bien les données sur la feuille résultat.
En pratique, je souhaite :
Pour chaque classe
copier les données F puis M, mais dans les feuilles portant le nom des
classes,
et chaque ligne collée étant espacée de la précédente d'une ligne vierge.
Sinon, c'est bizarre le PasteSpecial xlValue que j'ai ajouté ne fonctionne
pas.
@+
cordialement
J@@
'***
Sub b1()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(4).Select
ActiveSheet.PasteSpecial xlValue
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.PasteSpecial xlValue
Sheets("liste_test").Select
End If
Next ligne
End Sub
'***
FL wrote:dans le code, il fallait bien sûr initialiser i et j à 1,
Sub b()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
End If
Next ligne
End Sub
Cordialement
FL
Bonjour FL
merci pour le code, qui copie bien les données sur la feuille résultat.
En pratique, je souhaite :
Pour chaque classe
copier les données F puis M, mais dans les feuilles portant le nom des
classes,
et chaque ligne collée étant espacée de la précédente d'une ligne vierge.
Sinon, c'est bizarre le PasteSpecial xlValue que j'ai ajouté ne fonctionne
pas.
@+
cordialement
J@@
'***
Sub b1()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(4).Select
ActiveSheet.PasteSpecial xlValue
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.PasteSpecial xlValue
Sheets("liste_test").Select
End If
Next ligne
End Sub
'***
FL wrote:
dans le code, il fallait bien sûr initialiser i et j à 1,
Sub b()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
End If
Next ligne
End Sub
Cordialement
FL
Bonjour FL
merci pour le code, qui copie bien les données sur la feuille résultat.
En pratique, je souhaite :
Pour chaque classe
copier les données F puis M, mais dans les feuilles portant le nom des
classes,
et chaque ligne collée étant espacée de la précédente d'une ligne vierge.
Sinon, c'est bizarre le PasteSpecial xlValue que j'ai ajouté ne fonctionne
pas.
@+
cordialement
J@@
'***
Sub b1()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(4).Select
ActiveSheet.PasteSpecial xlValue
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.PasteSpecial xlValue
Sheets("liste_test").Select
End If
Next ligne
End Sub
'***
FL wrote:dans le code, il fallait bien sûr initialiser i et j à 1,
Sub b()
Sheets("résultat").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets("résultat").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Sheets("liste_test").Select
End If
Next ligne
End Sub
Cordialement
FL
Re bonjour
En fait il faut mettre
Range("A65536").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlValues
Re bonjour
En fait il faut mettre
Range("A65536").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlValues
Re bonjour
En fait il faut mettre
Range("A65536").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlValues
Hello
Sub b3()
Sheets("résultat").Range("A1:G65536").Delete
Sheets("CE1A").Range("A1:G65536").Delete
Sheets("CE1B").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Right(Range("A" & ligne), 4) = "CE1A" Then ligne = ligne + 2: feuille =
"CE1A"
If Right(Range("A" & ligne), 4) = "CE1B" Then ligne = ligne + 2: feuille =
"CE1B"
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets(feuille).Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveCell = "Sexe F": ActiveCell.Offset(1).Select
Selection.PasteSpecial Paste:=xlValues: Range("A1").Select
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets(feuille).Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveCell = "Sexe M": ActiveCell.Offset(1).Select
Selection.PasteSpecial Paste:=xlValues: Range("A1").Select
Sheets("liste_test").Select
End If
Next ligne
Range("A1").Select
End Sub
"J@@" <merci pour le code, qui copie bien les données sur la feuille résultat.
En pratique, je souhaite :
Pour chaque classe
copier les données F puis M, mais dans les feuilles portant le nom des
classes,
et chaque ligne collée étant espacée de la précédente d'une ligne vierge.
Sinon, c'est bizarre le PasteSpecial xlValue que j'ai ajouté ne fonctionne
pas.
Hello
Sub b3()
Sheets("résultat").Range("A1:G65536").Delete
Sheets("CE1A").Range("A1:G65536").Delete
Sheets("CE1B").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Right(Range("A" & ligne), 4) = "CE1A" Then ligne = ligne + 2: feuille =
"CE1A"
If Right(Range("A" & ligne), 4) = "CE1B" Then ligne = ligne + 2: feuille =
"CE1B"
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets(feuille).Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveCell = "Sexe F": ActiveCell.Offset(1).Select
Selection.PasteSpecial Paste:=xlValues: Range("A1").Select
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets(feuille).Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveCell = "Sexe M": ActiveCell.Offset(1).Select
Selection.PasteSpecial Paste:=xlValues: Range("A1").Select
Sheets("liste_test").Select
End If
Next ligne
Range("A1").Select
End Sub
"J@@" <
merci pour le code, qui copie bien les données sur la feuille résultat.
En pratique, je souhaite :
Pour chaque classe
copier les données F puis M, mais dans les feuilles portant le nom des
classes,
et chaque ligne collée étant espacée de la précédente d'une ligne vierge.
Sinon, c'est bizarre le PasteSpecial xlValue que j'ai ajouté ne fonctionne
pas.
Hello
Sub b3()
Sheets("résultat").Range("A1:G65536").Delete
Sheets("CE1A").Range("A1:G65536").Delete
Sheets("CE1B").Range("A1:G65536").Delete
For ligne = 1 To Range("A65536").End(xlUp).Row
i = 1: j = 1
If Right(Range("A" & ligne), 4) = "CE1A" Then ligne = ligne + 2: feuille =
"CE1A"
If Right(Range("A" & ligne), 4) = "CE1B" Then ligne = ligne + 2: feuille =
"CE1B"
If Range("A" & ligne) = "Sexe : F" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets(feuille).Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveCell = "Sexe F": ActiveCell.Offset(1).Select
Selection.PasteSpecial Paste:=xlValues: Range("A1").Select
Sheets("liste_test").Select
ElseIf Range("A" & ligne) = "Sexe : M" Then
Range("A" & ligne).Offset(2).Select
While ActiveCell.Offset(i) <> "": i = i - 1: Wend
While ActiveCell.Offset(j) <> "": j = j + 1: Wend
ligne1 = ActiveCell.Row + i + 2: ligne2 = ActiveCell.Row + j - 1
Range("B" & ligne1 & ":F" & ligne2).Copy
Sheets(feuille).Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveCell = "Sexe M": ActiveCell.Offset(1).Select
Selection.PasteSpecial Paste:=xlValues: Range("A1").Select
Sheets("liste_test").Select
End If
Next ligne
Range("A1").Select
End Sub
"J@@" <merci pour le code, qui copie bien les données sur la feuille résultat.
En pratique, je souhaite :
Pour chaque classe
copier les données F puis M, mais dans les feuilles portant le nom des
classes,
et chaque ligne collée étant espacée de la précédente d'une ligne vierge.
Sinon, c'est bizarre le PasteSpecial xlValue que j'ai ajouté ne fonctionne
pas.
Bonsoir "J@@" ,
expression:
"tomber dans les bras de Morphée": s'endormir
Morphée Divinité du sommeil,
Ce n'est pas pour danser le tamouré, encore moins une autre danse...
;o))
"J@@" <La ta proc fonctionne (même sous Xl2K v.9.0.6926 SP3)
et je peux jongler avec les robinets pour adapter le champ sélectionné.
impeccable (les Wend de FL ont aussi l'air de faire leur boulot)PS : (je ne sais si on t'a dit, Morphée est ... un mec !)
Gaaaarrghhhh !
Personne me dit jamais rien!! :-[
FxM wrote:
Fais une bise à Morphée si tu veux puis essaie ensuite :o)
@+
FxM
PS : (je ne sais si on t'a dit, Morphée est ... un mec !)
Bonsoir "J@@" ,
expression:
"tomber dans les bras de Morphée": s'endormir
Morphée Divinité du sommeil,
Ce n'est pas pour danser le tamouré, encore moins une autre danse...
;o))
"J@@" <
La ta proc fonctionne (même sous Xl2K v.9.0.6926 SP3)
et je peux jongler avec les robinets pour adapter le champ sélectionné.
impeccable (les Wend de FL ont aussi l'air de faire leur boulot)
PS : (je ne sais si on t'a dit, Morphée est ... un mec !)
Gaaaarrghhhh !
Personne me dit jamais rien!! :-[
FxM wrote:
Fais une bise à Morphée si tu veux puis essaie ensuite :o)
@+
FxM
PS : (je ne sais si on t'a dit, Morphée est ... un mec !)
Bonsoir "J@@" ,
expression:
"tomber dans les bras de Morphée": s'endormir
Morphée Divinité du sommeil,
Ce n'est pas pour danser le tamouré, encore moins une autre danse...
;o))
"J@@" <La ta proc fonctionne (même sous Xl2K v.9.0.6926 SP3)
et je peux jongler avec les robinets pour adapter le champ sélectionné.
impeccable (les Wend de FL ont aussi l'air de faire leur boulot)PS : (je ne sais si on t'a dit, Morphée est ... un mec !)
Gaaaarrghhhh !
Personne me dit jamais rien!! :-[
FxM wrote:
Fais une bise à Morphée si tu veux puis essaie ensuite :o)
@+
FxM
PS : (je ne sais si on t'a dit, Morphée est ... un mec !)
