Problème avec Xltoright

[mrzaitsev90]

Bonjour à tous,

Merci d'avance à ceux qui m'aideront.

Voici mon problème :

Dans ce fichier, http://cjoint.com/?0LyjHUJv8GW, vous trouverez plusieurs onglets. Ma demande ne concerne que les deux derniers à savoir "classement fournisseurs" et " SUIVI PERFORMANCE FOURNISSEURS".

Sur l'onglet "classement fournisseurs", j'aimerais pouvoir copier le contenu de la cellule AF7 et le copier sur la feuille "SUIVI PERFORMANCE FOURNISSEURS" en cellule B3, ce qui permettrait de commencer à incrémenter le graphique de suivi.

Mon problème est que, après plusieurs heures de recherche, je bute sur la notion en titre et que je n'arrive pas à faire ce que je souhaite :

Copier la première fois sur la B3 mais copier ensuite sur la C3 puis la D3 jusqu'à la cellule AA3 au fur et à mesure des cliques sur le bouton/macro situé sous la cellule AF7.

J'espère avoir été assez compréhensible. Je débute dans VBA.

Merci.

 

[Jack2]

Re : Problème avec Xltoright

Bonjour mrzaitsev90,

Code ci-après à essayer :

Sub CopierAF7()
Dim DerniereColonne As Long
Dim ColStr As String
With Sheets("SUIVI PERFORMANCE FOURNISSEURS")
    .Activate
    DerniereColonne = .Range("B3").End(xlToRight).Column
    If .Range("B3") = "" Then DerniereColonne = 1
    If .Range("C3") = "" Then DerniereColonne = 2
    If DerniereColonne >= 27 Then
        MsgBox "La colonne est déjà remplie"
        End
    End If
    ColStr = Split(Columns(DerniereColonne + 1).Address(ColumnAbsolute:=False), ":")(1) & 3
    .Range(ColStr) = Sheets("Classement fournisseurs").Range("AF7").Value
End With
End Sub

Bonnes fêtes
A+ Jack2

 

[mrzaitsev90]

Re : Problème avec Xltoright

Salut JAck2,

Un grand merci car ton code fonctionne à merveille. Pourriez-vous m'expliquer la partie du code ci-dessous :
ColStr = Split(Columns(DerniereColonne + 1).Address(ColumnAbsolute:=False), ":")(1) & 3
.Range(ColStr) = Sheets("Classement fournisseurs").Range("AF7").Value

J'aimerais savoir le reprogrammer dans d'autres conditions.

Votre aide m'était vraiment indispensable. Je n'aurais pas réussi avant 2020

Merci beaucoup.

Bonnes fêtes également.

 

[mrzaitsev90]

Re : Problème avec Xltoright

up ! Car, j'ai essayé de transférer ce code pour copier la cellule AF16 en B23 et ainsi de suite mais je n'y arrive...pas.

Pourriez-vous éclairer ma lanterne encore une fois s'il vous plait?

Merci encore.

Mrzaitsev90

 

[Jack2]

Re : Problème avec Xltoright

Re Bonjour mrzaitsev90,

J'ai trouvé ce code sur le net, je ne sais plus où, j'ai bien aimé le sens du raccourci que je n'aurais pas trouvé tout seul.

ColStr = Split(Columns(DerniereColonne + 1).Address(ColumnAbsolute:=False), ":")(1) & 3

Je l'utilise comme fonction :

Function ColStr(NCol As Integer) As String
    ColStr = Split(Columns(NCol).Address(ColumnAbsolute:=False), ":")(1)
End Function

où NCol est le numéro de la colonne que l'on veut transformer en lettre. Ex : 2 = B, 4 = D. (voir explications dans le fichier joint).

Pour ce qui concerne "copier la cellule AF16 en B23", Je suppose que tu veux remplir les cellules allant de B23 à AA23. Si c'est le cas, il suffit de remplacer & 3 à & 23 (cf. explications).

A+ Jack2

 

[mrzaitsev90]

Re : Problème avec Xltoright

Waw! la classe !

Un grand merci, tout fonctionne superbement bien. Génial ce code !!

Merci de ta dispo, de ta patience et de ta pédagogie !! C'est super !

Bonnes fêtes encore une fois !

Bonne continuation à toi aussi JAck2

Mrzaitsev90

 

[mrzaitsev90]

Re : Problème avec Xltoright

Option Explicit

Sub CopierAF7()
Dim DerniereColonne As Long
Dim ColStr As String
With Sheets("SUIVI PERFORMANCE FOURNISSEURS")
    .Activate
    DerniereColonne = .Range("B3").End(xlToRight).Column
    If .Range("B3") = "" Then DerniereColonne = 1
    If .Range("C3") = "" Then DerniereColonne = 2
    If DerniereColonne >= 27 Then
        MsgBox "Les semaines 51,52 sont déjà remplies", vbExclamation, "Année terminée!"
        End
    End If
    ColStr = Split(Columns(DerniereColonne + 1).Address(ColumnAbsolute:=False), ":")(1) & 3
    .Range(ColStr) = Sheets("Classement fournisseurs").Range("AF7").Value
End With
End Sub


Sub CopierAF16()
Dim DerniereColonne As Long
Dim ColStr As String
With Sheets("SUIVI PERFORMANCE FOURNISSEURS")
    .Activate
    DerniereColonne = .Range("B23").End(xlToRight).Column
    If .Range("B23") = "" Then DerniereColonne = 1
    If .Range("C23") = "" Then DerniereColonne = 2
    If DerniereColonne >= 27 Then
        MsgBox "La colonne est déjà remplie"
        End
    End If
    ColStr = Split(Columns(DerniereColonne + 1).Address(ColumnAbsolute:=False), ":")(1) & 23
    .Range(ColStr) = Sheets("Classement fournisseurs").Range("AF16").Value
End With
End Sub

Bonjour à tous,

J'aimerais savoir si ces deux macros seraient exécutables en une seule ? via un seul bouton macro?

Merci à ceux qui me fourniront une aide.

Bonnes fêtes de fin d'année!

 

[PascalXLD]

Re : Problème avec Xltoright

Bonjour

peut-être ceci

Option Explicit

Sub CopierAF7()
Dim DerniereColonne As Long
Dim ColStr As String
With Sheets("SUIVI PERFORMANCE FOURNISSEURS")
    .Activate
    DerniereColonne = .Range("B3").End(xlToRight).Column
    If .Range("B3") = "" Then DerniereColonne = 1
    If .Range("C3") = "" Then DerniereColonne = 2
    If DerniereColonne >= 27 Then
        MsgBox "Les semaines 51,52 sont déjà remplies", vbExclamation, "Année terminée!"
        End
    End If
    ColStr = Split(Columns(DerniereColonne + 1).Address(ColumnAbsolute:=False), ":")(1) & 3
    .Range(ColStr) = Sheets("Classement fournisseurs").Range("AF7").Value

    DerniereColonne = .Range("B23").End(xlToRight).Column
    If .Range("B23") = "" Then DerniereColonne = 1
    If .Range("C23") = "" Then DerniereColonne = 2
    If DerniereColonne >= 27 Then
        MsgBox "La colonne est déjà remplie"
        End
    End If
    ColStr = Split(Columns(DerniereColonne + 1).Address(ColumnAbsolute:=False), ":")(1) & 23
    .Range(ColStr) = Sheets("Classement fournisseurs").Range("AF16").Value
End With
End Sub

 

[Paf]

Re : Problème avec Xltoright

bonjour à tous,

si j'ai bien compris, il suffirait de copier les deux lignes suivantes de la deuxième macro:

ColStr = Split(Columns(DerniereColonne + 1).Address(ColumnAbsolute:=False), ":")(1) & 23
.Range(ColStr) = Sheets("Classement fournisseurs").Range("AF16").Value

juste avant le End With de la première macro

puisque le reste du code ne sert qu'à déterminer la colonne où écrire

Bonne suite

 

[mrzaitsev90]

Re : Problème avec Xltoright

Merci Messieurs,

Cela fonctionne à merveille. Il suffisait d'y penser. Bonne soirée !

Mrzaitsev90