Copie cellule d'une feuille sur une autre feuille celon critére

Bonjour a tous.

J'ai un petit souci, je cherche une solution pour copier des données sur un autre onglet celons des conditions.

Je m’explique.

J'ai un onglet base :

Colonne A: Domaine

Colonne B: Référence

Colonne C: Désignation

Colonne D: Quantité

Ensuite de colonne E a Q: des magasin ( ce qui représente mes autre onglet 1 par colonne)

J'aimerais que si dans les colonnes de E a Q valeur supérieur a 0, les données des colonnes A, B, C et la colonne (E a Q concerner)soit recopier dans les différent onglet représentant c'est colonne que la données de E a Q concerné soit dans la cellule D et si possible que c'est onglet soit filtrer par la colonne B référence.

Je vous joint un fichier exemple pour mieux comprendre.

Pouvez vous SVP m'aider a résoudre ce problème.

11fichier-test.zip (13.72 Ko)

bonjour

je n'ai rien compris de cette phrase.

J'aimerais que si dans les colonnes de E a Q valeur supérieur a 0, les données des colonnes A, B, C et la colonne (E a Q concerner)soit recopier dans les différent onglet représentant c'est colonne que la données de E a Q concerné soit dans la cellule D et si possible que c'est onglet soit filtrer par la colonne B référence.

Bonjour,

est ce que les données de l'onglet "Base" doivent être transféré en une seule opération ?

les données doivent être mit sous les données existante ou doit-on écraser les données existante des feuil1à feuil12 avant le transfert ?

Pour faire simple en D j'ai une Qté totale qui est dispatcher dans les colonne E a Q

j'ai ensuite un onglet par colonne:

E5 feuille1 donc onglet Feuil1

F5 feuille2 donc onglet Feuil2

G5 feuille3 donc onglet Feuil3

H5 feuille4 donc onglet Feuil4

I5 feuille5 donc onglet Feuil5

J5 feuille6 donc onglet Feuil6

K5 feuille7 donc onglet Feuil7

L5 feuille8 donc onglet Feuil8

M5 feuille9 donc onglet Feuil9

N5 feuille10 donc onglet Feuil10

O5 feuille11 donc onglet Feuil11

P5 feuille12 donc onglet Feuil12

Q5 feuille13 donc onglet Feuil13

etc...

J'aimerai que si les cellule de Qté des colonne E a Q quand elle sont supérieur a 0

les colonnes A,B,C soit copier dans les onglet magasin avec la Qté de ces colonnes

et qu'un tri automatique se fasse par la colonne B

Voire exemple joint

Bonjour,

est ce que les données de l'onglet "Base" doivent être transféré en une seule opération ?

les données doivent être mit sous les données existante ou doit-on écraser les données existante des feuil1à feuil12 avant le transfert ?

Peut importe soit une suppression soit une mise a jour le principal c'est que les changement fait en base soit pris en compte dans les autre onglet

Il doit y avoir une seul ligne par référence

Bonjour,

à tester,

Sub test_transfert()
With Sheets("Base")
 BaseLastRow = .Cells(Rows.Count, "B").End(xlUp).Row
 For i = 6 To BaseLastRow
  For y = 5 To 17
    If .Cells(i, y) <> "" Then
     existe = Evaluate("Match(" & .Cells(i, "B").Address & "," & .Cells(5, y) & "!" & "B:B, 0)")
     If Not IsError(existe) Then
      Sheets(.Cells(5, y).Value).Cells(existe, "D").Value = .Cells(i, y).Value
     Else
      lastRow = Sheets(.Cells(5, y)).Cells(Rows.Count, "B").End(xlUp).Row + 1
      Sheets(.Cells(5, y)).Cells(lastRow, "A") = .Cells(i, 1)
      Sheets(.Cells(5, y)).Cells(lastRow, "B") = .Cells(i, 2)
      Sheets(.Cells(5, y)).Cells(lastRow, "C") = .Cells(i, 3)
      Sheets(.Cells(5, y)).Cells(lastRow, "D") = .Cells(i, y)
     End If
    End If
  Next
 Next
End With
End Sub

Bonjour cette macro renvois une erreur a la ligne

 lastRow = Sheets(.Cells(5, y)).Cells(Rows.Count, "B").End(xlUp).Row + 1

voici la correction,

Sub test_transfert()
With Sheets("Base")
 BaseLastRow = .Cells(Rows.Count, "B").End(xlUp).Row
 For i = 6 To BaseLastRow
  For y = 5 To 17
    If .Cells(i, y) <> "" Then
     existe = Evaluate("Match(" & .Cells(i, "B").Address & "," & .Cells(5, y) & "!" & "B:B, 0)")
     If Not IsError(existe) Then
      Sheets(.Cells(5, y).Value).Cells(existe, "D").Value = .Cells(i, y).Value
     Else
      lastRow = Sheets(.Cells(5, y).Value).Cells(Rows.Count, "B").End(xlUp).Row + 1
      Sheets(.Cells(5, y).Value).Cells(lastRow, "A") = .Cells(i, 1)
      Sheets(.Cells(5, y).Value).Cells(lastRow, "B") = .Cells(i, 2)
      Sheets(.Cells(5, y).Value).Cells(lastRow, "C") = .Cells(i, 3)
      Sheets(.Cells(5, y).Value).Cells(lastRow, "D") = .Cells(i, y)
     End If
    End If
  Next
 Next
End With
End Sub

Bonjour

Merci cette macro fonctionne bien.

J'aimerai savoir si on pouvez ajouter dans la macro un tri automatique sur la référence en colonne B

Bonne réception.

Cordialement.

Je viens de m'apercevoir que si je retire une ligne en base celle ci ne se retire pas dans les onglets

dans ce cas,

Sub test_transfert2()
Dim lastRow(1 To 12), i As Integer, y As Integer, BaseLastRow As Integer
Application.Calculation = xlManual

BaseLastRow = Sheets("Base").Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To 12
  Sheets("Feuil" & i).Rows("6:" & BaseLastRow).ClearContents
  lastRow(i) = 6
Next

With Sheets("Base")
 For i = 6 To BaseLastRow
  For y = 5 To 16
    If .Cells(i, y) <> "" Then
      Sheets(.Cells(5, y).Value).Cells(lastRow(y - 4), "A").Value = .Cells(i, 1).Value
      Sheets(.Cells(5, y).Value).Cells(lastRow(y - 4), "B").Value = .Cells(i, 2).Value
      Sheets(.Cells(5, y).Value).Cells(lastRow(y - 4), "C").Value = .Cells(i, 3).Value
      Sheets(.Cells(5, y).Value).Cells(lastRow(y - 4), "D").Value = .Cells(i, y).Value
      lastRow(y - 4) = lastRow(y - 4) + 1
    End If
  Next
 Next
End With
Application.Calculation = xlAutomatic
MsgBox "Traitement terminer"
End Sub

Merci beaucoup sa fonctionne

Rechercher des sujets similaires à "copie feuille celon critere"