Discussion :

[ced0802]

Bonjour a tous,

Je souhaiterais avoir lq macro suivante qui fonctionne pour les lignes que je selectionne. C est un copie colle de certaines cellule de la ligne en question.
La macro suivante fonctionne seulement lorsque je precise le numero de la ligne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Copypaste() 
    For x = 1 To 10000 
 
        If x = ThisWorkbook.Worksheets("sheet1").Cells(2, 11) Then 
            ThisWorkbook.Worksheets("sheet1").Cells(13, 1) = Workbooks("List Of materials").Worksheets("Sheet1").Cells(x, 1) 
            ThisWorkbook.Worksheets("sheet1").Cells(13, 5) = Workbooks("List Of materials").Worksheets("Sheet1").Cells(x, 2) 
            ThisWorkbook.Worksheets("sheet1").Cells(13, 2) = Workbooks("List Of materials").Worksheets("Sheet1").Cells(x, 6) 
            ThisWorkbook.Worksheets("sheet1").Cells(13, 3) = Workbooks("List Of materials").Worksheets("Sheet1").Cells(x, 7) 
            ThisWorkbook.Worksheets("sheet1").Cells(13, 4) = Workbooks("List Of materials").Worksheets("Sheet1").Cells(x, 5) 
            ThisWorkbook.Worksheets("sheet1").Cells(13, 7) = Workbooks("List Of materials").Worksheets("Sheet1").Cells(x, 9) 
            Range("A2:D2").Select 
            ActiveCell.FormulaR1C1 = "NAME OF PERSON REQUESTING WRITE OFF:  "Ced" 
 
            ThisWorkbook.Worksheets("sheet1").Cells(4, 1) = "DATE : " & "" & Date 
 
        End If 
    Next x 
End Sub

Merci a vous par avance,

[Neutthsch]

Salut Ced,

Des petits conseils :

• Pour alléger la lecture de ton code, n'hésite pas à nommer tes objets

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set Final = ThisWorkbook.Worksheets("Feuil1")
Set Init = Workbooks("List Of materials").Worksheets("Sheet1")

Comme ça tu utilise leurs noms. Surtout dans des codes avec de la répétition comme ici

• La plus part du temps (ils y a des exceptions) il n'est pas nécessaire de sélectionner (une cellule, une plage...) pour y appliquer une action.

Du coup,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
  Range("A2:D2").Select 
            ActiveCell.FormulaR1C1 = "NAME OF PERSON REQUESTING WRITE OFF:  Pat DOYLE"

Devient

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("A2:D2").FormulaR1C1 = "NAME OF PERSON REQUESTING WRITE OFF:  Pat DOYLE"

• Et maintenant pour répondre à ta question, il suffit de choisir la ligne de cellule active, de lui donner un petit nom (ici "LigneAvecUnPetitNom") pour plus de lisibilité et le tour est joué.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Copypaste()
 
Set Final = ThisWorkbook.Worksheets("Feuil1")
Set Init = Workbooks("List Of materials").Worksheets("Sheet1")
 
LigneAvecUnPetitNom = ActiveCell.Row
 
    For x = 1 To 10000
 
        If x = Final.Cells(2, 11) Then
            Final.Cells(LigneAvecUnPetitNom, 1) = Init.Cells(x, 1)
            Final.Cells(LigneAvecUnPetitNom, 2) = Init.Cells(x, 6)
            Final.Cells(LigneAvecUnPetitNom, 3) = Init.Cells(x, 7)
            Final.Cells(LigneAvecUnPetitNom, 4) = Init.Cells(x, 5)            
            Final.Cells(LigneAvecUnPetitNom, 5) = Init.Cells(x, 2)            
            Final.Cells(LigneAvecUnPetitNom, 7) = Init.Cells(x, 9)
 
            Range("A2:D2").FormulaR1C1 = "NAME OF PERSON REQUESTING WRITE OFF:  Pat DOYLE"
 
            Final.Cells(4, 1) = "DATE : " & "" & Date
        End If
 
    Next x
 
End Sub

[Neutthsch]

Edit : Sur une plage, ça se complique un poil car il faut passer les lignes en revue :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Dim LigneAvecUnPetitNom as range
For Each LigneAvecUnPetitNom In Selection.Rows
...

Soit:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub Copypaste()
Dim LigneAvecUnPetitNom as range
 
Set Final = ThisWorkbook.Worksheets("Feuil1")
Set Init = Workbooks("List Of materials").Worksheets("Sheet1")
 
 
For Each LigneAvecUnPetitNom In Selection.Rows
 
    For x = 1 To 10000
 
        If x = Final.Cells(2, 11) Then
            Final.Cells(LigneAvecUnPetitNom, 1) = Init.Cells(x, 1)
            Final.Cells(LigneAvecUnPetitNom, 2) = Init.Cells(x, 6)
            Final.Cells(LigneAvecUnPetitNom, 3) = Init.Cells(x, 7)
            Final.Cells(LigneAvecUnPetitNom, 4) = Init.Cells(x, 5)            
            Final.Cells(LigneAvecUnPetitNom, 5) = Init.Cells(x, 2)            
            Final.Cells(LigneAvecUnPetitNom, 7) = Init.Cells(x, 9)
 
            Range("A2:D2").FormulaR1C1 = "NAME OF PERSON REQUESTING WRITE OFF:  Pat DOYLE"
 
            Final.Cells(4, 1) = "DATE : " & "" & Date
        End If
 
    Next
 
Next
 
End Sub

[ced0802]

Merci beaucoup pour ton aide.
Cependant je souhaite que lorsque je selectionne ma ligne dans fichier "liste of Material", les cellules correspondantes a ma macro se copient collent dans le 2eme fichier "Wite off etc..." (ligne apres ligne si plusieurs selectionnees)
Il se peut que j'ai a selectionner plusieurs lignes egalement.

Ce que j ai pour l instant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Copypaste()
 
For x = 1 To 10000
 
Set Final = ThisWorkbook.Worksheets("Sheet1")
Set Init = Workbooks("List Of materials").Worksheets("Sheet1")
 
ligneactive = Init.ActiveCell.EntireRow
 
If x = ligneactive Then
Final.Cells(13, 1) = Init.Cells(x, 1)
Final.Cells(13, 5) = Init.Cells(x, 2)
Final.Cells(13, 2) = Init.Cells(x, 6)
Final.Cells(13, 3) = Init.Cells(x, 7)
Final.Cells(13, 4) = Init.Cells(x, 5)
Final.Cells(13, 7) = Init.Cells(x, 9)
 
Range("A2:D2").FormulaR1C1 = "NAME OF PERSON REQUESTING WRITE OFF:  Ced"
 
 
ThisWorkbook.Worksheets("sheet1").Cells(4, 1) = "DATE : " & "" & Date
 
 
 
 
 
End If
 
Next x
 
End Sub

Merci encore

[Neutthsch]

Merci beaucoup pour ton aide.
Cependant je souhaite que lorsque je selectionne ma ligne dans fichier "liste of Material", les cellules correspondantes a ma macro se copient collent dans le 2eme fichier "Wite off etc..." (ligne apres ligne si plusieurs selectionnees)
Il se peut que j'ai a selectionner plusieurs lignes egalement.

Bon on va reprendre du début parce que là y a un gros décalage entre ta première demande, ton code et ta deuxième demande.

t'as une boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For x = 1 To 10000
...
Next

qui incrémente une variable x qui recherche le numéro de la bonne ligne dans ton tableau "liste of Material" (au passage liste en anglais c'est list)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 If x = Cells(2, 11) Then
            Cells(LigneAvecUnPetitNom, 1) = Init.Cells(x, 1)
            Cells(LigneAvecUnPetitNom, 2) = Init.Cells(x, 6)
            Cells(LigneAvecUnPetitNom, 3) = Init.Cells(x, 7)
            Cells(LigneAvecUnPetitNom, 4) = Init.Cells(x, 5)            
            Cells(LigneAvecUnPetitNom, 5) = Init.Cells(x, 2)            
            Cells(LigneAvecUnPetitNom, 7) = Init.Cells(x, 9)
 
            Range("A2:D2").FormulaR1C1 = "NAME OF PERSON REQUESTING WRITE OFF:  Pat DOYLE"
 
            Cells(4, 1) = "DATE : " & "" & Date
End If

Donc tu ne peux pas demander à ta macro de copier les cellules qui se trouve à la fois sur la ligne "x" et sur la ligne sélectionnée (vu qu'une cellule ne se trouve que sur une seule ligne.

Avec les indications que je t'ai donné précédemment tu devrais pouvoir faire ce que tu veux, mais avant tout pose clairement ce que tu as tête et tu verras que la construction viendra beaucoup plus facilement.

[ced0802]

Voila ou j'en suis :

Ma macro fonctionne lorsque je selectionne une ligne dans le fichier "List of Materials". C'est à dire que ça me copie bien les cellules souhaitées (qui font partie de la ligne selectionnée) oour être collées dans mon fichier base "Thisworkbook" (dans ma ligne 13).
Ce que je souhaiterais, et que je n'arrive pas à faire fonctionner, est de selectionner plusieurs lignes (par exemple 5 ou 6 lignes) et que ça me les copie de la même façon dans "ThisWorkbook" les une à la suite des autres (ligne 13 , puis 14 etc..)

Voici le code dans fichier "List of Materials" dans la partie thisworkbook :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Private mSelectedSheet As String
Private mSelectedRow As Long
 
Private Sub Workbook_SheetSelectionChange(ByVal Sht As Object, ByVal Target As Range)
    mSelectedSheet = Sht.Name
    mSelectedRow = Target.Row
End Sub
 
Public Property Get SelectedSheet() As String
    SelectedSheet = mSelectedSheet
End Property
 
Public Property Get SelectedRow() As Long
SelectedRow = mSelectedRow
End Property

Voici le code dans mon fichier de base :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Copypaste()
 
    Set Final = ThisWorkbook.Worksheets("Sheet1")
    Set Lom = Workbooks("List Of materials")
 
 
    x = Lom.SelectedRow
    Y = Final.Cells(Rows.Count, 1).End(xlUp).Row + 1
    If Y < 13 Then Y = 13
    If Y > 27 Then
        MsgBox "this Request for Writeoff is full, Please save and use a new one"
        Exit Sub
    End If
 
    Final.Cells(Y, 1) = Lom.Worksheets("sheet1").Cells(x, 1)
    Final.Cells(Y, 2) = Lom.Worksheets("sheet1").Cells(x, 6)
    Final.Cells(Y, 3) = Lom.Worksheets("sheet1").Cells(x, 7)
    Final.Cells(Y, 4) = Lom.Worksheets("sheet1").Cells(x, 5)
    Final.Cells(Y, 5) = Lom.Worksheets("sheet1").Cells(x, 2)
    Final.Cells(Y, 7) = Lom.Worksheets("sheet1").Cells(x, 9)
 
    Final.Range("A2") = "NAME OF PERSON REQUESTING WRITE OFF:  Ced"
 
    Final.Cells(4, 1) = "DATE : " & Date
 
 
End Sub

En vous remerciant pour votre aide précieuse.

[Neutthsch]

En faite tu oublies d'incrémenter tes lignes autant sur ton tableau de départ que sur ton tableau d'arrivé

pose clairement ce que tu as tête et tu verras que la construction viendra beaucoup plus facilement.

On veut naviguer entre plusieurs lignes du tableau "List of Materials" donc il faut qu'on identifie les lignes:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Dim VarLigne as range
For Each VarLigne In Selection.Rows

Sur les lignes en question tu veux récupérer des informations dans cellules qui ne se suivent pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Set Lom = Workbooks("List Of materials").Worksheets("sheet1")
...=Lom.Cells(VarLigne,1)
...=Lom.Cells(VarLigne,6)

Et les coller dans des cellules qui ne se suivent pas d'un autre tableau

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set Final = ThisWorkbook.Worksheets("Sheet1")
Final.Cells(DestinationLigne, 1)=...

Bon j'imagine que si on a X lignes sélectionnées dans "List Of materials" on colle sur X DestinationLigne donc il faut aussi les incrémenter. l'idée s'est de travailler dans la boucle for que l'on vient de créer en demandant à notre valeur d'augmenter de +1 à chaque passage.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

DestinationLigne=DestinationLigne+1

On monte tout ça ensemble et là dessus on va pouvoir gérer les conditions :
Ici j'ai créé une variable supplémentaire DestinationDeDepart qui enregistre le numéro de la première ligne écrite du tableau d'arrivé pour ne pas dépasser DestinationDeDepart+27

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub test()
Dim VarLigne As Range
Dim DestinationLigne As Integer
 
Set Lom = Workbooks("List Of materials").Worksheets("sheet1")
Set Final = ThisWorkbook.Worksheets("Sheet1")
 
DestinationLigne = Final.Cells(Rows.Count, 1).End(xlUp).Row
DestinationDeDepart = DestinationLigne
If DestinationLigne < 13 Then DestinationLigne = 13
 
For Each VarLigne In Selection.Rows
    DestinationLigne = DestinationLigne + 1
 
    If DestinationLigne > DestinationDeDepart + 27 Then
        MsgBox "this Request for Writeoff is full, Please save and use a new one"
        Exit Sub
    End If
 
    Final.Cells(DestinationLigne, 1) = Lom.Cells(VarLigne, 1)
    Final.Cells(DestinationLigne, 2) = Lom.Cells(VarLigne, 6)
    Final.Cells(DestinationLigne, 3) = Lom.Cells(VarLigne, 7)
    Final.Cells(DestinationLigne, 4) = Lom.Cells(VarLigne, 5)
    Final.Cells(DestinationLigne, 5) = Lom.Cells(VarLigne, 2)
    Final.Cells(DestinationLigne, 7) = Lom.Cells(VarLigne, 9)
 
Next
    Final.Cells(2, 1) = "NAME OF PERSON REQUESTING WRITE OFF:  Ced"
 
    Final.Cells(4, 1) = "DATE : " & Date
 
End Sub

J'ai pas exécuter, donc c'est possible que des erreurs se soient glissées

[Marc-L]

Bonjour, bonjour !

Pour alléger la lecture de ton code, n'hésite pas à nommer tes objets

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set Final = ThisWorkbook.Worksheets("Feuil1")

Inutile pour les feuilles de calculs du classeur contenant le code, leurs CodeNames étant déjà définis ‼
Par défaut le CodeName de la feuille "Feuil1" est Feuil1 à utiliser directement à la place de Final …

Complément d'information ici …

______________________________________________________________________________________________________
Je suis Charlie, …