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

Question

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

f894009 · Answer

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

pijaku · Answer

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
&#127932; Cordialement,
Franck &#127926;

Coo76 · Answer

ça marche !! Merci beaucoup !! :)

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

3 réponses

Discussions similaires

Newsletters