Copie d'un nombre sur un code déjà existant

Résolu
Coo76 -  
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,
je dispose d'un code VBA qui me transfère un texte d'un onglet à l'autre si la valeur à gauche est non nul.
Maintenant mon problème est que j'aimerais transféré le nombre également sur l'autre onglet, quelqu'un pense pouvoir m'aider ?

le code est le suivant : 
Option Explicit

Public Const FR = "Résultat"
'Public Const coCodFR = 2
Public Const lidebFR = 3

Public Const FC = "Codes"
Public Const coCodFC = 1
Public Const lidebFC = 2

' copie le tableau où les codes sont en colonne co
Public Sub Kopie(co As Long)
Dim liFR As Long, lifinFR As Long, TC(), s As String, nbCod As Long, q As Long, lifinFC As Long
With Sheets(FR)
  lifinFR = .Cells(Rows.Count, co).End(xlUp).Row
  If lifinFR < lidebFR Then
    MsgBox "pas de codes dans le tableau colonne " & co
    Exit Sub
  End If
  nbCod = 0
  For liFR = lidebFR To lifinFR
    s = .Cells(liFR, co).Value
    q = .Cells(liFR, co + 1)
    If q <> 0 Then
    nbCod = nbCod + 1
      ReDim Preserve TC(1 To nbCod)
      s = s
      TC(nbCod) = s
    End If
  Next liFR
End With
With Sheets(FC)
  lifinFC = .Cells(Rows.Count, coCodFC).End(xlUp).Row
  .Cells(lifinFC + 1, coCodFC).Resize(nbCod, 1) = Application.Transpose(TC)
End With
End Sub

' pour copier les 3 tableaux
' appel à Kopie avec les colonnes 2, 6, 10
Public Sub OK()
  Call RAZ
  Call Kopie(2)
  Call Kopie(6)
  Call Kopie(10)
End Sub

' nettoyage de la feuille Codes
Public Sub RAZ()
Dim lifinFC As Long
With Sheets(FC)
  lifinFC = .Cells(Rows.Count, coCodFC).End(xlUp).Row
  If lifinFC < lidebFC Then lifinFC = lidebFC
  .Range(.Cells(lidebFC, coCodFC), .Cells(lifinFC, coCodFC + 1)).ClearContents
End With
End Sub
A voir également:

3 réponses

Réponse 1 / 3
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

si la valeur à gauche est non nul. Pour moi, dans votre code c'est la colonne de droite, mais c'est vous qui voyez.

Utilisez un deuxieme tableau pour memoriser les valeurs de cette colonne
0
Réponse 2 / 3
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour,

Salutations f894009.

Une autre solution consiste à utiliser un tableau à deux dimensions : 
Public Sub Kopie(co As Long)
Dim liFR As Long, lifinFR As Long, TC(), s As String, nbCod As Long, q As Long, lifinFC As Long
With Sheets(FR)
  lifinFR = .Cells(Rows.Count, co).End(xlUp).Row
  If lifinFR < lidebFR Then
    MsgBox "pas de codes dans le tableau colonne " & co
    Exit Sub
  End If
  nbCod = 0
  For liFR = lidebFR To lifinFR
    s = .Cells(liFR, co).Value
    q = .Cells(liFR, co + 1)
    If q <> 0 Then
      nbCod = nbCod + 1
      ReDim Preserve TC(1 To 2, 1 To nbCod)
      's = s 'LIGNE INUTILE
      TC(1, nbCod) = s
      TC(2, nbCod) = q
    End If
  Next liFR
End With
With Sheets(FC)
  lifinFC = .Cells(Rows.Count, coCodFC).End(xlUp).Row
  .Cells(lifinFC + 1, coCodFC).Resize(nbCod, 2) = Application.Transpose(TC)
End With
End Sub

🎼 Cordialement,
Franck 🎶
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Salut
0
Réponse 3 / 3
Coo76
 
ça marche !! Merci beaucoup !! :)
0