XL 2016 Mon code VBA me renvoi une erreur

INFINITY100 · 3 Mai 2023

Salut à tous

Voila je suis face à un petit problème, car ici j'ai un classeur nommé "Ma Facture.xlsm" qui contient l'ensemble de données à copier vers un autre classeur après l'appel d'ouverture à savoir le classeur "Mon Tableau de bord.xlsm". Jusque là tout va bien.

Sauf que lors de la copie, VBA me génère une erreur dont j'arrive pas à corriger et du coup mes données qui sont dans "Ma Facture.xlsm" ne se copie pas vers "Mon Tableau de bord.xlsm" et étant un débutant en VBA je n'ai aucune idée quoi faire.

Donc voila si quelqu'un aurait une une idée elle sera la bienvenue

Mon code d'ouverture et de copie de données :

VB:

Dim sh As Worksheet
Dim sFormula1 As String
Dim sFormula2 As String
Dim DernierID As Integer
Dim lignevide As Integer
Dim MonApplication As Object
Dim MonTBdeBord As String
 
Sub Copier_Coller(Feuille As String, CopyRange As String)
 
   Set MonApplication = CreateObject("Shell.Application")
 
   MonTBdeBord = "C:\Users\INFINITY\Desktop\Mon-Dossier\Mon Tableau de bord.xlsm" 'à remplacer par le chemin du fichier
   MonApplication.Open (MonTBdeBord)
 
   Set MonApplication = Nothing
 
    With Worksheets(Feuille).Range("AJ68")
        
        If Worksheets(Feuille).Range("AJ68").Value Like "*CFA*" Then
            
             Set sh = Workbooks.Open("C:\Users\INFINITY\Desktop\Mon-Dossier\Mon Tableau de bord.xlsm").Sheets("1-CFA")
        
         ElseIf Worksheets(Feuille).Range("AJ68").Value Like "*UREA*" Then
            
            Set sh = Workbooks.Open("C:\Users\INFINITY\Desktop\Mon-Dossier\Mon Tableau de bord.xlsm").Sheets("2-UREA")
            
            Else
            
            Set sh = Workbooks.Open("C:\Users\INFINITY\Desktop\Mon-Dossier\Mon Tableau de bord.xlsm").Sheets("3-UFI")
         End If
    End With
    DernierID = WorksheetFunction.Max(sh.Range("B:B"))
    lignevide = sh.Range("B" & Rows.Count).End(xlUp).Row + 1
 If lignevide < 3 Then lignevide = 3
    sh.Cells(lignevide, 2) = DernierID + 1
    sh.Range("C" & lignevide).Resize(, Sheets(Feuille).Range(CopyRange).Count) = Application.Transpose(Range(CopyRange))
    sFormula1 = "=SIERREUR(SOMME($H$" & lignevide & "*$I$" & lignevide & ");""Attention ! il y a une erreur !"")"
    sFormula2 = "=SIERREUR(SOMME($J$" & lignevide & ":$K$" & lignevide & ");""Attention ! il y a une erreur !"")"
    sh.Cells(lignevide, "J").FormulaLocal = sFormula1
    sh.Cells(lignevide, "L").FormulaLocal = sFormula2
End Sub

'Pour l'appel :

Sub Validation()
    Copier_Coller "Devis N° 100-2023 DT 1002-2023", "AJ65: AJ76"
End Sub

Voici la ligne ou le code s’arrête :

VB:

sh.Range("C" & lignevide).Resize(, Sheets(Feuille).Range(CopyRange).Count) = Application.Transpose(Range(CopyRange))

NB: à noter que si je met cette ligne qui fait défaut en mode commentaire le reste du code s’exécute parfaitement

Je joins les deux fichier pour être plus explicite

Merci à vous tous pour l'aide

Cordialement

ChTi160 · 3 Mai 2023

Bonsoir INFINiTY100
Quel code, texte d'erreur ?
Jean marie

INFINITY100 · 3 Mai 2023

ChTi160 à dit:
Bonsoir INFINiTY100
Quel code, texte d'erreur ?
Jean marie

il me renvoi l’erreur "L'indice n'appartient pas à la sélection" et s’arrête sur la ligne suscitée

Valtrase · 3 Mai 2023

Salut,
Vérifie ce que contient la variable Feuille au moment ou cela plante.

mutzik · 4 Mai 2023

bjr

essaie en remplaçant
Dim DernierID As Integer
Dim lignevide As Integer
par
Dim DernierID
Dim lignevide

ChTi160 · 4 Mai 2023

Bonjour le Fil
ne manque t'il pas le Nombre de Lignes dans le Resize

VB:

sh.Range("C" & lignevide).Resize(, Sheets(Feuille).Range(CopyRange).Count) = Application.Transpose(Range(CopyRange))

car tu as

Code:

.Resize(, Sheets(Feuille).Range(CopyRange).Count)

Tu pourrais avoir (sans avoir testé) un trux comme celà.

Code:

sh.Range("C" & lignevide).Resize(Sheets(Feuille).Range(CopyRange).Rows.Count, Sheets(Feuille).Range(CopyRange).Columns.Count) = Application.Transpose(Range(CopyRange))

de plus pourquoi le Transpose de ta Plage "CopyRange" ?
Jean marie

INFINITY100 · 8 Mai 2023

Merci bcp messieurs d'avoir la peine de me répondre et pour vos propositions.

finalement j'ai reçu une solution sur une autre discussion de monsieur FRANCH55
au quel cette dernière répond parfaitement à mes besoins
1000 mercis encore à vous tous

Cordialement

et voici le code juste pour le partage

VB:

VB:
Option Explicit
Sub Validation()
ThisWorkbook.Worksheets("Devis N° 100-2023 DT 1002-2023").Activate
Copier_Coller [AJ65: AJ76], [Aj68], ThisWorkbook
Copier_Coller [AJ65: AJ76], [Aj68], Workbooks.Open(ThisWorkbook.Path & "\Mon Tableau de bord.xlsm")
End Sub

Sub Copier_Coller(Plage As Range, Crit As String, Wb As Workbook)
Dim Last As Variant, Sh As Worksheet
With Wb
Select Case True
Case Crit Like "*CFA*":     Set Sh = .Sheets("1-CFA")
Case Crit Like "*UREA*":    Set Sh = .Sheets("2-UREA")
Case Crit Like "*UFI*":     Set Sh = .Sheets("2-UFI")
Case Else:                  Exit Sub
End Select
End With
With Sh
Last = WorksheetFunction.Max(.Cells(.Rows.Count, "B").End(xlUp).Row + 1, 3)
.Cells(Last, "B") = WorksheetFunction.Max(.Range("B:B")) + 1
.Cells(Last, "C").Resize(, Plage.Count) = Application.Transpose(Plage)
.Cells(Last, "J").FormulaLocal = "=SIERREUR(SOMME($H$" & Last & "*$I$" & Last & ");""Attention ! il y a une erreur !"")"
.Cells(Last, "L").FormulaLocal = "=SIERREUR(SOMME($J$" & Last & ":$K$" & Last & ");""Attention ! il y a une erreur !"")"
End With
End Sub

XL 2016 Mon code VBA me renvoi une erreur

INFINITY100

XLDnaute Occasionnel

Pièces jointes

ChTi160

XLDnaute Barbatruc

INFINITY100

XLDnaute Occasionnel

Valtrase

XLDnaute Occasionnel

mutzik

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

INFINITY100

XLDnaute Occasionnel

Discussions similaires