bertrandmislog
XLDnaute Nouveau
Bonsoir,
J’ai copié le code d’un spécialiste pour réaliser une macro.
Cette dernière fonctionne parfaitement. Je cherche à adapter le code de façon à coller à partir d’une cellule de mon choix dans l'autre feuille.
Code actuellement utilisé.
Sub Test_copie_ligne() ' Vers une autre feuille suivant un critère de choix
Dim Plage As Range
Dim c As Variant
trie = InputBox("Choix de marchandise ?") 'Demander la marchandise à trier
c = trie
frigo = InputBox("Dans quel frigo ?") 'Demande le frigo de destination
With Worksheets("Frais fixes") 'Fixe la boucle sur cette page
Set Plage = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row) 'définir la plage à copier
End With
For Each c In Plage
If c = trie Then
With c.Resize(1, 12) 'Nombre de colonne pris en compte
.Copy Destination:=Sheets(frigo).Cells(Rows.Count, 1).End(xlUp).Offset(1) 'Copie chaque ligne dans le frigo demandé
'======== la copie s'exécute correctement mais à partir de A2, je souhaite copier à compter de A15
'.ClearContents ' ou .delete xlshiftup pour supprimer
.Font.Italic = True
End With
End If
Next
End Sub
Merci d’aider un vieux, mais débutant…:
J’ai copié le code d’un spécialiste pour réaliser une macro.
Cette dernière fonctionne parfaitement. Je cherche à adapter le code de façon à coller à partir d’une cellule de mon choix dans l'autre feuille.
Code actuellement utilisé.
Sub Test_copie_ligne() ' Vers une autre feuille suivant un critère de choix
Dim Plage As Range
Dim c As Variant
trie = InputBox("Choix de marchandise ?") 'Demander la marchandise à trier
c = trie
frigo = InputBox("Dans quel frigo ?") 'Demande le frigo de destination
With Worksheets("Frais fixes") 'Fixe la boucle sur cette page
Set Plage = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row) 'définir la plage à copier
End With
For Each c In Plage
If c = trie Then
With c.Resize(1, 12) 'Nombre de colonne pris en compte
.Copy Destination:=Sheets(frigo).Cells(Rows.Count, 1).End(xlUp).Offset(1) 'Copie chaque ligne dans le frigo demandé
'======== la copie s'exécute correctement mais à partir de A2, je souhaite copier à compter de A15
'.ClearContents ' ou .delete xlshiftup pour supprimer
.Font.Italic = True
End With
End If
Next
End Sub
Merci d’aider un vieux, mais débutant…:
