Amélioration de code + erreur 1 fois sur 2 Résolu

Question

Bonjour, 

Aïe Aïe Aïe...
Les puristes vont avoir mal aux yeux... En "bidouillant" avec l'enregistreur de macro, et avec l'aide de quelques uns pour quelques bouts de code, j'arrive à transformer mon fichier d'export de stock en fichier intégrable par Amazon.
Cependant, exactement 1 fois sur 2 j'ai une erreur "La méthode select de la classe Range a échoué" à la ligne surlignée.
Pourquoi ?

Sub Macro1()
Dim Source As Workbook
Dim Cible As Range
Dim DerniereCellule As Range
    Set Source = Workbooks.Open("C:\Users\Gérard\Desktop\Export.xls")
    Set Cible = ThisWorkbook.Worksheets("Export").Range("A1")
    With Source.Worksheets("A")
        Set DerniereCellule = .Cells.SpecialCells(xlCellTypeLastCell)
        .Range(Cells(1, 1), DerniereCellule).Copy Cible
    End With
    Source.Saved = True
    Source.Close
Dim dlig As Long, lig As Long
  dlig = Range("L" & Rows.Count).End(xlUp).Row
  For lig = dlig To 2 Step -1
    If UCase(Cells(lig, 12)) = "PAS DE VPC" Then Rows(lig).Delete
  Next lig
Dim rng As Range
 Set rng = ThisWorkbook.Worksheets("EXPORT").Range("A1").CurrentRegion
 rng.Columns(12).SpecialCells(xlCellTypeBlanks) = "SANS CATEGORIE"
Dim I As Long
Dim SKU As Range
Dim QUANTITE As Range
Dim PRIX As Range
Dim CATEGORIE As Range
Dim ProductIdType As Range
Dim ItemCondition As Range
Dim AddDelete As Range
Dim WillShip As Range
Dim ExpeditedShipping As Range
Dim ItemNote As Range
Dim Fulfillment As Range
Set SKU = Range("A2:A" & Range("A2").End(xlDown).Row)
Set QUANTITE = Range("C2:C" & Range("C2").End(xlDown).Row)
Set PRIX = Range("G2:G" & Range("G2").End(xlDown).Row)
Set CATEGORIE = Range("L2:L" & Range("L2").End(xlDown).Row)
Set ProductIdType = Range("C2:C" & Range("C2").End(xlDown).Row)
Set ItemCondition = Range("E2:E" & Range("E2").End(xlDown).Row)
Set AddDelete = Range("G2:G" & Range("G2").End(xlDown).Row)
Set WillShip = Range("H2:H" & Range("H2").End(xlDown).Row)
Set ExpeditedShipping = Range("I2:I" & Range("I2").End(xlDown).Row)
Set ItemNote = Range("J2:J" & Range("J2").End(xlDown).Row)
Set Fulfillment = Range("K2:K" & Range("K2").End(xlDown).Row)
    Worksheets("EXPORT").Activate

SKU.Select -----------------------> ERREUR

Selection.Copy
    Worksheets("majamazonFR").Activate
    Range("A2").Select
    Worksheets("majamazonFR").Paste
    Worksheets("EXPORT").Activate
    SKU.Select
    Selection.Copy
    Worksheets("majamazonFR").Activate
    Range("B2").Select
    Worksheets("majamazonFR").Paste
    Worksheets("EXPORT").Activate
    PRIX.Select
    Selection.Copy
    Worksheets("majamazonFR").Activate
    Range("D2").Select
    Worksheets("majamazonFR").Paste
    Worksheets("EXPORT").Activate
    QUANTITE.Select
    Selection.Copy
    Worksheets("majamazonFR").Activate
    Range("F2").Select
    Worksheets("majamazonFR").Paste
    'Worksheets("EXPORT").Activate
    'CATEGORIE.Select
    'Selection.Copy
    'Worksheets("majamazonFR").Activate
    'Range("L2").Select
    'Worksheets("majamazonFR").Paste
Dim li As Long, lifin As Long
Application.ScreenUpdating = False
With Sheets("EXPORT")
  lifin = .Range("A" & Rows.Count).End(xlUp).Row
  For li = 2 To lifin
    If Left(.Range("A" & li), 1) = "B" Then
      Sheets("majamazonFR").Range("C" & li).Value = 1
    Else
      Sheets("majamazonFR").Range("C" & li).Value = 4
    End If
  Next li
End With
Set rng = ThisWorkbook.Worksheets("majamazonFR").Range("A1").CurrentRegion
 rng.Columns(5).SpecialCells(xlCellTypeBlanks) = "11"
Set rng = ThisWorkbook.Worksheets("majamazonFR").Range("A1").CurrentRegion
 rng.Columns(7).SpecialCells(xlCellTypeBlanks) = "a"
Set rng = ThisWorkbook.Worksheets("majamazonFR").Range("A1").CurrentRegion
 rng.Columns(8).SpecialCells(xlCellTypeBlanks) = "19"
Set rng = ThisWorkbook.Worksheets("majamazonFR").Range("A1").CurrentRegion
 rng.Columns(9).SpecialCells(xlCellTypeBlanks) = "N"
Set rng = ThisWorkbook.Worksheets("majamazonFR").Range("A1").CurrentRegion
 rng.Columns(10).SpecialCells(xlCellTypeBlanks) = "Envois quotidiens à la levée de 17h. LE spécialiste du voyage sur majamazonFR. Envois quotidiens, protégés. Satisfait ou remboursé. Plus de 5000 références dédiées au voyage (Récits, guides, rando, cartes, beaux livres, jeunesse...)"
Set rng = ThisWorkbook.Worksheets("majamazonFR").Range("A1").CurrentRegion
 rng.Columns(11).SpecialCells(xlCellTypeBlanks) = "DEFAULT"
Application.CutCopyMode = False
    ChDir "C:\Users\Gérard\Desktop"
    ActiveWorkbook.SaveAs Filename:="C:\Users\Gérard\Desktop\majamazonFR.txt", _
        FileFormat:=xlText, CreateBackup:=False
Worksheets("EXPORT").Range("A1").Cells.Clear
With Worksheets("majamazonFR").Rows("2:65536").EntireRow.Delete
End With
ActiveWorkbook.Save
End Sub


     EDIT : Ajout du LANGAGE dans les balises de code (la coloration syntaxique).
Explications disponibles ici : ICI 

Merci d'y penser dans tes prochains messages.

Configuration: Windows / Firefox 54.0

ThauTheme · Answer

Bonjour Leghe, bonjour le forum,

Tu navigues entre plusieurs onglets, il te faut donc spécifier systématiquement l'onglet de la plage que tu désignes. Je te recommande de créer des variables pour chaque onglet utilisé pour simplifier l'écriture du code. Ensuite, la règle d'or c'est d'éviter les Select inutiles qui ne font que ralentir l'exécution du code et sont sources de bug (c'est ton cas). Pour terminer, il est d'usage de placer la déclaration des variables en début du code...

Remarques : tu as définis les variables QUANTITE et ProductIdType avec la même plage de cellulles. Idem pour PRIX et AddDelete. C'est normal ? 
Tu copies/colles deux fois SKU, c'est normal ?

Ton code modifié respectant les trois points :

Sub Macro1()
Dim CS As Workbook
Dim OS As Worksheet
Dim CC As Workbook
Dim OE As Worksheet
Dim OM As Worksheet
Dim Cible As Range
Dim DerniereCellule As Range
Dim dlig As Long, lig As Long
Dim rng As Range
Dim I As Long
Dim SKU As Range
Dim QUANTITE As Range
Dim PRIX As Range
Dim CATEGORIE As Range
Dim ProductIdType As Range
Dim ItemCondition As Range
Dim AddDelete As Range
Dim WillShip As Range
Dim ExpeditedShipping As Range
Dim ItemNote As Range
Dim Fulfillment As Range
Dim li As Long, lifin As Long

Set CS = Workbooks.Open("C:\Users\Gérard\Desktop\Export.xls")
Set OS = CS.Worksheets("A")
Set CC = ThisWorkbook
Set OE = CC.Worksheets("Export")
Set OM = CC.Worksheets("majamazonFR")
Set Cible = OE.Range("A1")
Set DerniereCellule = OS.Cells.SpecialCells(xlCellTypeLastCell)
OS.Range(Cells(1, 1), DerniereCellule).Copy Cible
CS.Close False 'ferme le classeur sans enregistrer
dlig = OE.Range("L" & Rows.Count).End(xlUp).Row
For lig = dlig To 2 Step -1
    If UCase(OE.Cells(lig, 12)) = "PAS DE VPC" Then Rows(lig).Delete
Next lig
Set rng = OE.Range("A1").CurrentRegion
rng.Columns(12).SpecialCells(xlCellTypeBlanks) = "SANS CATEGORIE"
Set SKU = OE.Range("A2:A" & OE.Range("A2").End(xlDown).Row)
Set QUANTITE = OE.Range("C2:C" & OE.Range("C2").End(xlDown).Row)
Set PRIX = OE.Range("G2:G" & OE.Range("G2").End(xlDown).Row)
Set CATEGORIE = OE.Range("L2:L" & OE.Range("L2").End(xlDown).Row)
Set ProductIdType = OE.Range("C2:C" & OE.Range("C2").End(xlDown).Row) 'déja attribué à QUANTITE ?
Set ItemCondition = OE.Range("E2:E" & OE.Range("E2").End(xlDown).Row)
Set AddDelete = OE.Range("G2:G" & OE.Range("G2").End(xlDown).Row) 'déja attribué à PRIX ?
Set WillShip = OE.Range("H2:H" & OE.Range("H2").End(xlDown).Row)
Set ExpeditedShipping = OE.Range("I2:I" & OE.Range("I2").End(xlDown).Row)
Set ItemNote = OE.Range("J2:J" & OE.Range("J2").End(xlDown).Row)
Set Fulfillment = OE.Range("K2:K" & OE.Range("K2").End(xlDown).Row)
SKU.Copy OM.Range("A2")
SKU.Copy OM.Range("B2") 'pourquoi deux fois ?
PRIX.Copy OM.Range("D2")
Worksheets("majamazonFR").Paste
Worksheets("EXPORT").Activate
QUANTITE.Copy OM.Range("F2")

'CATEGORIE.Copy OM.Range("L2")

Application.ScreenUpdating = False
lifin = OE.Range("A" & Rows.Count).End(xlUp).Row
For li = 2 To lifin
    If Left(OE.Range("A" & li), 1) = "B" Then
        OM.Range("C" & li).Value = 1
    Else
        OM.Range("C" & li).Value = 4
    End If
Next li
Set rng = OM.Range("A1").CurrentRegion
rng.Columns(5).SpecialCells(xlCellTypeBlanks) = "11"
rng.Columns(7).SpecialCells(xlCellTypeBlanks) = "a"
rng.Columns(8).SpecialCells(xlCellTypeBlanks) = "19"
rng.Columns(9).SpecialCells(xlCellTypeBlanks) = "N"
rng.Columns(10).SpecialCells(xlCellTypeBlanks) = "Envois quotidiens à la levée de 17h. LE spécialiste du voyage sur majamazonFR. Envois quotidiens, protégés. Satisfait ou remboursé. Plus de 5000 références dédiées au voyage (Récits, guides, rando, cartes, beaux livres, jeunesse...)"
rng.Columns(11).SpecialCells(xlCellTypeBlanks) = "DEFAULT"
ChDir "C:\Users\Gérard\Desktop"
CC.SaveAs Filename:="C:\Users\Gérard\Desktop\majamazonFR.txt", _
FileFormat:=xlText, CreateBackup:=False
OE.Range("A1").Cells.Clear
OM.Rows("2:65536").EntireRow.Delete
CC.Save
Application.ScreenUpdating = True
End Sub

Leghe · Answer

Merci de votre réponse, si rapide !

Une erreur (méthode paste classe worksheet) à cet endroit : 
Worksheets("majamazonFR").Paste

Sinon, oui SKU à copier 2 fois, et mea culpa pour les 2 autres !

ThauTheme · Answer

Re,

Oui désolé ces deux lignes sont à supprimer dans le code. J'ai oublié de le faire :

Worksheets("majamazonFR").Paste
Worksheets("EXPORT").Activate

Mais bon, tu aurais dû le voir par toi-même !...

Leghe · Answer

C'est vrai...
Merci encore, j'ai un totem à vénérer maintenant !

ThauTheme · Answer

Re,

Arf ! Surtout pas ! Si tu me vénères ça va me véner grave !... (oui des fois je parle djeuns mais ça fait trop marrer mon fils ado)...

Leghe · Answer

Hello ThauTheme,

Je ne comprends pas, ce matin cela ne fonctionne plus :

J'ai l'erreur "Impossible de définir la propriété SpecialCells de la classe Range"
à cette ligne là : 
rng.Columns(5).SpecialCells(xlCellTypeBlanks) = "11"

???

Amélioration de code + erreur 1 fois sur 2

6 réponses

Discussions similaires

Newsletters