Copier coller selon conditions

Bonjour

Je souhaiterai créer une macro pour pouvoir de l'onglet source créer un onglet par fournisseur reprenant chaque ligne où ce fournisseur est présent.

Comme un fichier permets de comprendre plus facilement je joins à mon post un extrait

J'ai repris le code proposé dans ce post: https://forum.excel-pratique.com/post463529.html#p463529

Etant novice en VBA j'ai essayé de comprendre le code est de l'adapter néanmoins je tombe toujours sur la même erreur d'indice ..

Voici mon code la ligne de bug est indiquée par ==>

Option Explicit

Dim ln, lgn, col, fs

Dim nf As String

Sub Exporter()

Application.ScreenUpdating = False

Set fs = ActiveSheet

For ln = 2 To fs.Range("A" & Rows.Count).End(xlUp).Row

nf = fs.Range("A" & ln)

If (nf = "FAKIR") And fs.Range("I" & ln) <> "X" Then

lgn = Sheets(nf).Range("A" & Rows.Count).End(xlUp)(2).Row

fs.Range("A" & ln & ":I" & ln).Copy

Sheets(nf).Range("A" & lgn).PasteSpecial xlPasteValues

fs.Range("I" & ln) = "X"

End If

Next ln

fs.Select

MsgBox "Exportations terminées"

End Sub

Si j'ai compris cette erreur serait due à une erreur de dimension de tableau..

Merci d'avance pour votre précieuse aide

Bonjour,

à tester

cliquer sur le bouton "lancez"(dans la feuille "Source") puis visiter les autres feuilles

Bonjour minanse,

Tout d'abord je te remercie pour ce coup de pouce

Néanmoins je ne comprends pas très bien ton code sachant que:

*je ne vois nulle part les conditions pour l’exécution du copier coller (le fichier que j'avais joint n'était qu'un exemple)

*a chaque copier coller une ligne vide apparaît entre chaque ligne "trouvée" en source dans les nouveaux onglets

Concrètement je n'arrive pas réellement à réutiliser le code..

voici le code commenté

Sub Exporter()

'déclarer les variable
Dim ln, lgn, col, fs
Dim nf As String

Application.ScreenUpdating = False

Set fs = ActiveSheet

For ln = 2 To fs.Range("A" & Rows.Count).End(xlUp).Row  'parcour la feuille source

nf = fs.Range("A" & ln)  'on récupère le nom du fournisseur

For i = 1 To Worksheets.Count  'on parcours les feuilles dans le classeur
If Worksheets(i).Name = nf Then  'on cherche la feuille corresponds au fournisseur si on trouve pas de feuille corespond au fournisseur on passe à la ligne suivante sans sopier la ligne actuelle    LA CONDITION EST ICI 
lgn = Sheets(nf).Range("A" & Rows.Count).End(xlUp)(2).Row + 1  'on récupère la dernière ligne  null dans la feuille du fournisseur
fs.Range("A" & ln & ":I" & ln).Copy Sheets(nf).Range("A" & lgn) 'on colle la ligne sur la bonne feuille
End If
Next i
Next ln

MsgBox "Exportations terminées"
End Sub

une petit correction sur le code concernant les ligne vide :

remplacez

lgn = Sheets(nf).Range("A" & Rows.Count).End(xlUp)(2).Row + 1

par

lgn = Sheets(nf).Range("A" & Rows.Count).End(xlUp)(2).Row 

Bonjour,

Je comprends beaucoup mieux maintenant

Je voulais savoir s'il était possible afin d'optimiser le code de:

* automatiser la création des onglets et non faire une rechercher par rapport aux onglets existants qui doivent donc être créés au préalable

* Permettre l'utilisation du code pour effectuer une mise à jour et donc ne copier que les lignes n'apparaissant pas déjà dans un onglet fournisseur (le clé d’identification de chaque ligne est le numéro réserve)

Merci beaucoup en tout cas pour votre aide

voila le code un peu modifier :

Sub Exporter()

'déclarer les variable
Dim ln, lgn, col, fs
Dim nf As String
Dim existe As Boolean

Application.ScreenUpdating = False

Set fs = ActiveSheet

For ln = 2 To fs.Range("A" & Rows.Count).End(xlUp).Row  'parcour la feuille source

nf = fs.Range("A" & ln)  'on récupère le nom du fournisseur

For i = 1 To Worksheets.Count  'on parcours les feuilles dans le classeur
If Worksheets(i).Name = nf Then 'on cherche la feuille corresponds au fournisseur si on trouve pas de feuille corespond au fournisseur on passe à la ligne suivante sans sopier la ligne actuelle
lgn = Sheets(nf).Range("A" & Rows.Count).End(xlUp).Row + 1  'on récupère la dernière ligne  null
fs.Range("A" & ln & ":I" & ln).Copy Sheets(nf).Range("A" & lgn) 'on colle la lignesur la bonne feuille
existe = True
End If
Next i
If existe = False Then 'si la feuille fournisseur existe pas
  Sheets.Add 'on crée une nouvelle feuille
  ActiveSheet.Name = nf 'on nomme la nouvelle feuille avec le nom du fournisseur
  fs.Range("A1:I1").Copy Sheets(nf).Range("A1") 'on lui met la 1er ligne (légende)
  lgn = Sheets(nf).Range("A" & Rows.Count).End(xlUp).Row + 1 'on fait commen en-dessus
  fs.Range("A" & ln & ":I" & ln).Copy Sheets(nf).Range("A" & lgn)
End If
Next ln

MsgBox "Exportations terminées"
End Sub

atib a écrit :

* Permettre l'utilisation du code pour effectuer une mise à jour et donc ne copier que les lignes n'apparaissant pas déjà dans un onglet fournisseur (le clé d’identification de chaque ligne est le numéro réserve)

on peut revenir au méthode que vous avez utiliser , mettez des "X" sur la colonne I pour dire qu'il ne faut pas copier