Copier colonne en fonction combobox

Question

C'est une nouvelle fois que je viens vers vous concernant mon programme, Il est maintenant finalisé, j'ai pu y ajouter des fonctions mais un problème intervient lorsque je copie les 4 dernières colonnes de la feuille recap_stock vers la feuille accueil. Cette étape se fait lors de l'appui sur le bouton "Calcul transfert", cela fonctionne bien pour les autres colonnes mais pour les 4 dernières le stock qui est copié est inversé. Je ne sais pas s'il y a un problème dans le code, est-ce que quelqu'un à une idée ? Je vous remercie par avance pour votre retour...

Invité · Accepted Answer

Re,

Voici ton code modifié et une fonction personnalisée

Private Sub CalculTransfert_Click()              'Calcul le stock en cours de l'équipe A et B
  Dim sChoix As String
  Dim ShtRS As Worksheet                         ' Pour définir la feuille Récap Stock
  Dim ShtA As Worksheet                          ' Pour définir la feuile Accueil de destination
  Dim ColE As Long, ColD As Long, dLig As Long

  Sheets("Accueil").Protect DrawingObjects:=False, Contents:=False, Scenarios:=False 'déverrouille l'édition de l'accueil
  Application.ScreenUpdating = False
  Calculate
  ' Définir la feuille
  Set ShtRS = ThisWorkbook.Sheets("Recap_stock")
  Set ShtA = ThisWorkbook.Sheets("Accueil")
  ' Dernière ligne du tableau
  dLig = ShtRS.Range("E" & Rows.Count).End(xlUp).Row
  ' Numéro de colonne du lieu d'émission
  sChoix = Me.ComboBox1.Value
  ' Trouver la colonne avec ce nom
  ColE = ColFind(ShtRS, 3, sChoix)
  ' Si la valeur retournée est 0
  If ColE = 0 Then
    MsgBox "Problème pour trouver : " & Me.ComboBox1 & " dans la feuille [" & ShtRS.Name & "]", vbCritical, "OUPS..."
    Set ShtRS = Nothing: Set ShtA = Nothing
  End If
  ' Copier coller les valeur
  ShtRS.Range(ShtRS.Cells(5, ColE), ShtRS.Cells(dLig, ColE)).Copy
  ShtA.Range("K15").PasteSpecial Paste:=xlPasteValues
  ' Numéro de colonne du lieu de destination
  sChoix = Me.ComboBox2.Value
  ' Trouver la colonne avec ce nom
  ColD = ColFind(ShtRS, 3, sChoix)
  ' Copier coller les valeur
  ShtRS.Range(ShtRS.Cells(5, ColD), ShtRS.Cells(dLig, ColD)).Copy
  ShtA.Range("G15").PasteSpecial Paste:=xlPasteValues
  ShtA.Range("H11").Activate
  ' Désactiver le copier/coller
  Application.CutCopyMode = False
  Sheets("Accueil").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'verrouille l'édition de l'accueil
  Application.ScreenUpdating = True
  ' Effacer les variables objet
  Set ShtRS = Nothing: Set ShtA = Nothing
End Sub

Et dans un module

' Fonction pour trouver la colonne contenant le critère de la ligne indiquée
Function ColFind(oSht As Worksheet, NumRow As Long, sCrit As String)
  Dim CelF As Range
  With oSht.Rows(NumRow)
    ' Rechercher la valeur correspondante
    Set CelF = .Find(What:=sCrit, LookIn:=xlValues, LookAt:=xlWhole, _
      SearchOrder:=xlByColumns, MatchCase:=False)
    ' Si la cellule à été trouvée
    If Not CelF Is Nothing Then
      ColFind = CelF.Column
    Else
      ColFind = 0
    End If
  End With
End Function

Comme ça, la bonne colonne sera trouvée et copiée, si j'ai bien tout compris

A+

Invité · Answer

D'après ce que tu décris, le problème ce situerait ici ShtRS.Range(ShtRS.Cells(5, Cole), ShtRS.Cells(dLig, Cole)).Copy Avec cette ligne de code, tu ne copies que la 29ème colonne, c''est tout A+...

Invité · Answer

Re,

Si tu mets un point d'arrêt (F9) sur ta première ligne de "Set ShtRS" tu peux voir les valeurs que prennent tes variables

Dans la feuille Accueil est choisi "MBH", lorsque le code passe sur le numéro de colonne d'émission, voilà ce qui s'affiche lorsque tu mets le curseur dessus

La ligne en jaune, copie donc de la ligne 5 à 97 de la colonne 29

Cette colonne 29 c'est AC

Donc il y a un soucis de correspondance

Invité · Answer

Re, Comme je ne sais pas comment fonctionne le fichier j'ai corrigé le code de mon post précédent en espérant que cela résolve le souci. A+...