Plages dynamiques du "Name Manager" en VBA

Le 22/01/2016 à 12:09

Bonjour à tous,

Je travaille sur un fichier composé de 7 colonnes et un nombre de lignes variables.

Mes colonnes sont toujours disposées ainsi:

A: Organisation commerciale --> juste un code fixe.

B: Numéro de client --> entre 1 et 5 numéros par client, ces numéros sont toujours soit de 6 soit de 8 caractères. En cas de codes multiples, ceux-ci sont toujours séparés par un espace.

C: IRC --> Le code du produit

D: Le prix associé au code produit et au client

E: la devise, associée au code client

F: La date de début de validité du prix

G: La date de fin de validité du prix

Problème:

Mon problème se situe au niveau de la colonne B, le fichier final que je veux obtenir doit être compréhensible par SAP. SAP ne tolère qu'un seul code client par client. Ainsi pour les clients à multiples codes (disons N) je duplique les lignes concernées par celui-ci N-1 fois et j'applique chaque code client à chaque set de lignes. Voir image ci-jointe si ce n'est pas clair!

Pour cela j'ai le code suivant qui fonctionne sur mon fichier test.

En revanche les plages comme Data , Length List, DataOut ou encore Crit ont été définies par le "Name manager" directement dans Excel (je ne sais pas faire autrement). Elles sont donc définies pour le workbook sur lequel j'ai testé ma macro, où tout fonctionne à merveille.

SAUF que quand je veux faire tourner cette macro sur un autre workbook, je me retrouve avec des erreurs d'objets non définis.. forcément puisque mes plages n'existent pas.

En résumé : comment définir mes plages dans des variables directement dans le code pour que ma macro marche ?

Sub CreateDuplicates()
    Dim lLastRow As Long, lRept As Long, arCust() As String, lCustNo As Long, x As Long

Dim DataOut As Range
Dim crit As Range
Dim LengthList As Range
Dim Data As Range

Sheet2.Range("'Duplicated'!$I$1:$O$1").Name = "DataOut"
Sheet2.Range("'Duplicated'!$R$1:$R$2").Name = "crit"
Sheet1.Range("'ConsoSheet'!$J$1").Name = "LengthList"
Sheet1.Range("=OFFSET(ConsoSheet!$A$1,0,0,COUNTA(ConsoSheet!$A:$A),7)").Name = "Data"

    Application.ScreenUpdating = False
    arCust() = Split(Range("J2"), " ")
    Sheet2.Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    lLastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    Range("Data").AdvancedFilter Action:=xlFilterCopy, copytorange:=Range("LengthList"), unique:=True

    For lRept = 1 To Range("LengthList").CurrentRegion.Rows.Count - 1

        Range("DataOut").CurrentRegion.Offset(1, 0).ClearContents
        Range("crit").Cells(2, 1) = Range("LengthList").Cells(lRept + 1, 1)
        Range("Data").AdvancedFilter Action:=xlFilterCopy, copytorange:=Range("DataOut"), criteriarange:=Range("crit")
        arCust() = Split(Sheet2.Range("J2"), " ")
        lCustNo = UBound(arCust()) + 1
        lLastRow = Sheet2.Range("I" & Rows.Count).End(xlUp).Row
        For x = 0 To lCustNo - 1
            Sheet2.Range("J2:J" & lLastRow) = arCust(x)
            Range("Data_Temp").Offset(1, 0).Copy Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Cells(2, 1)
        Next x

    Next lRept
    Application.ScreenUpdating = True

End Sub

Voici mes plages telles qu'enregistrées dans le name manager:

Crit = Duplicated!$Q$1:$Q$2
DataOut =Duplicated!$I$1:$O$1
Data =OFFSET(ConsoSheet!$A$1;0;0;COUNTA(ConsoSheet!$A:$A);8)
LengthList =ConsoSheet!$I$1

Ci-joint: le workbook dans lequel les plages sont enregistrées et la macro fonctionne : v2TEST_EU(3)

Un autre workbook du même format sur lequel je souhaite faire tourner ma macro mais où elle ne marche pas : Mise_en_oeuvre

explanations
14mise-en-oeuvre.xlsx (80.93 Ko)
14v2test-eu-3.xlsm (173.91 Ko)
Le 22/01/2016 à 12:29

Bonjour

proposition de correction à l'aveugle (à tester)

Sub CreateDuplicates()
    Dim lLastRow As Long, lRept As Long, arCust() As String, lCustNo As Long, x As Long

Dim DataOut As Range
Dim crit As Range
Dim LengthList As Range
Dim Data As Range
  Set ws1 = Sheets("Duplicated") ' = sheet 2 ?
  Set ws2 = Sheets("ConsoSheet") ' = sheet 1 ?
Set DataOut = ws1.Range("I1:O1")
Set crit = ws1.Range("R1:R2")
Set LengthList = ws2.Range("J1")
With ws2
dl = .Cells(Rows.Count, 7).End(xlUp).Row
Set Data = .Range("A1:G" & dl)
End With

    Application.ScreenUpdating = False
    arCust() = Split(Range("J2"), " ")
    ws1.Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    lLastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
    Data.AdvancedFilter Action:=xlFilterCopy, copytorange:=LengthList, unique:=True

    For lRept = 1 To LengthList.CurrentRegion.Rows.Count - 1

        DataOut.CurrentRegion.Offset(1, 0).ClearContents
        crit.Cells(2, 1) = LengthList.Cells(lRept + 1, 1)
        Data.AdvancedFilter Action:=xlFilterCopy, copytorange:=DataOut, criteriarange:=crit
        arCust() = Split(Sheet2.Range("J2"), " ")
        lCustNo = UBound(arCust()) + 1
        lLastRow = ws1.Range("I" & Rows.Count).End(xlUp).Row
        For x = 0 To lCustNo - 1
            ws1.Range("J2:J" & lLastRow) = arCust(x)
            'Range("Data_Temp").Offset(1, 0).Copy Destination:=ws1.Range("A" & Rows.Count).End(xlUp).Cells(2, 1)
            'data_temp n'est pas défini ?
            Data.Offset(1, 0).Copy Destination:=ws1.Range("A" & Rows.Count).End(xlUp).Cells(2, 1)
        Next x

    Next lRept
    Application.ScreenUpdating = True

End Sub
Le 22/01/2016 à 13:49

Bonjour

Bonjour h2so4

La moindre des choses est de donner une suite à la proposition que je t'ai faite

Que cette solution ne te convienne pas, j'en suis conscient et ne me gène pas du tout, mais que l'on ne dise rien est frustrant

https://forum.excel-pratique.com/excel/mise-en-dynamique-d-un-code-t72874.html#p416781

Le 22/01/2016 à 14:37

@Banzai:

Oh mille excuses Banzai! Pour tout vous dire j'ai posté mon problème dans plusieurs forums afin d'obtenir plusieurs points de vue et je vous avoue que j'avais complètement oublié de revenir vers vous à propos de votre réponse.

Ce n'est pas excusable car c'est clairement de ma faute !

Je me permets de vous répondre ici si vous le voulez bien.

Je suis biend 'accord avec cette solution dans la mesure où elle fixe directement dans le code ce à quoi font référence les termes Data, Crit, DataOut et LengthList.

Cependant en le faisant tourner j'obtiens une erreur "Method Range of object_Global failed" ... Très obscure pour moi.

L'erreur pointe sur la ligne :

 Range("Data_Temp").Offset(1, 0).Copy Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Cells(2, 1)

J'en déduis que je n'ai pas explicité le terme Data_Temp, donc j'ai ajouté à votre code la ligne :

 .Names.Add Name:="Data_Temp", RefersToR1C1:="=OFFSET(Duplicated!$I$1;0;0;COUNTA(Duplicated!$I:$I);7)"

Et cette fois j'obtiens "The formula you typed contains an error", mais je ne vois pas laquelle DU TOUT.

Mes excuses encore pour avoir omis de poster ma réponse!

@h2SO4

Merci pour votre réponse. Le code tourne mais du coup la macro ne sépare plus les codes clients donc je suis embêtée.

Je vais creuser cette piste cependant.

Rechercher des sujets similaires à "plages dynamiques name manager vba"