L
Louise
Guest
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 [file name=test_20050616091335.zip size=20701]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/test_20050616091335.zip[/file] [file name=test_20050616091335.zip size=20701]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/test_20050616091335.zip[/file]
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 [file name=test_20050616091335.zip size=20701]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/test_20050616091335.zip[/file] [file name=test_20050616091335.zip size=20701]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/test_20050616091335.zip[/file]
