XL 2019 1004 sur un ActiveSheet.Paste

Cheyenne_2021

XLDnaute Junior
Copie de données filtrées du Fichier 1 dans plusieurs fichiers2 (selon les filtres)

1004 sur ActiveSheet. Paste

Logique car la feuille active est la feuille du fichier dans lequel je vais copier mais pour ouvrir le fichier et selectionner le tableau dans lequel je vais faire la copie, je suis obligée d’activer cette feuille, non ?

Si juste avant le ActiveSheet. Paste , je fais un Activate sur la feuille d’origine j’ai une erreur 9 sur la Activesheet. Paste

Je ne sais pas quoi faire !
Merci,


VB:
Sub Creation_Fichier_UR()
'
'Pour eviter le message : qu'une fnom de colonne que je veux copier contient le nom "xxx" qui existe sur la feuille de destination.
'Voulez-vous utiliser cette version du nom ?" ma réponse est toujours oui.

Application.DisplayAlerts = False
Application.EnableEvents = False


'Deproteger
 Call Initialisation_Variables_Public
 Call Deverrouiller_feuille(Onglet_Synthèse)    'du fihcier POurscission
 
 
  decal = Range("T_UR2[[#Headers]]").Row
  Ent = "A" & (decal + 1)
 
  sheet_1 = ActiveSheet.Name
 ' Fichier UR
 '----------
 'UR_Repertoire = "Z:\S3A - Documents de service\Procédures\MEQ Recherche\"
 'UR_Repertoire = [REP_BO_Extracion]
 AR_Repertoire = [Rep_BO_Extraction]
 AR_Fichier = [Fich_BO_Extraction]
 MsgBox ("AR fichier: " & AR_Fichier)
 Nb_Lig = [T_UR_Nom].Rows.Count
 For I = 1 To 3
    Windows(AR_Fichier).Activate
     UR_Nomfichier = Worksheets("Parametres").Range("T_UR_Nom[Nom_fichier]").Rows(I)
    Critere = Range("T_UR_Nom[sigles UR]").Rows(I)
     UR_Nomfichier_T = UR_Nomfichier & ".xlsm"
    UR_Date = Format([Extract_Date], "dd/mm/yy")
    Sjeet_Active = ActiveSheet.Name
    

  
    Worksheets(sheet_1).ListObjects("T_UR2").Range.AutoFilter Field:=1, Criteria1:=Critere
     Range(Ent).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    
    UR_Repertoire = [Rep_UR]    'là où se trouvent les fichiers des UR
    UR_nomTotal = UR_Repertoire & " " & UR_Nomfichier & ".xlsm"
    Workbooks.Open Filename:=UR_Repertoire & UR_Nomfichier & ".xlsm"    ' ouverture du fichier dans lequel on va copier une partie du fichier d'origine
  
        
    Windows(UR_Nomfichier_T).Activate
    Set Onglet_UR = ActiveWorkbook.Worksheets("TableauSynthese_UR")
    Call Deverrouiller_feuille(Onglet_UR)    ' de chaque fichier UR
      Onglet1 = Worksheets(1).Name
    Book1 = ActiveWorkbook.Name
'    NTab_Sel = Worksheets(Onglet1).ListObjects(1).Name
     MsgBox ("active sheet : " & ActiveSheet.Name)
    ActiveSheet.Paste Destination:=Worksheets(Onglet1).ListObjects(NTab_Sel)
    MsgBox ("date extract : " & UR_Date)
    Worksheets("TableauSynthese_UR").Range("UR_Extract_Date").Value = UR_Date
      Call Verouiller_feuille(Onglet_UR)
      ActiveWorkbook.Close saveChanges:=True
    
    'Fin fichier UR
    '--------------
Next
    
    Call Verouiller_feuille(Onglet_Synthèse)    ' unquement à la fin de la creation de tous les fichiers ?
    
    
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
 

Pièces jointes

  • POURSCISSION_Tableau Edition Personnels par UR.xlsm
    360.3 KB · Affichages: 3
  • CEL_Tableau Edition Personnel.xlsm
    79.5 KB · Affichages: 3

job75

XLDnaute Barbatruc
Bonjour Cheyenne_2021,

Entre les instructions .Copy et .Paste il ne faut pas qu'il y ait de modifications de cellules.

Le bug est dû au déverrouillage de la feuille de destination après .Copy.

Et pourquoi ne pas utiliser la méthode plage.Copy cellule ?

A+
 

job75

XLDnaute Barbatruc
Je suis bien obligée d'ouvrir le fichier, d’enlever le verrouillage ?
Oui mais il faut déverrouiller la feuille de destination avant l'instruction .Copy.
Je ne connais pas méthode plage.Copy cellule
Exécutez avec 2 feuilles Feuil1 et Feuil2 :
VB:
Sub Test()
Sheets("Feuil1").Range("A1:D10").Copy Sheets("Feuil2").Range("A1")
End Sub
Pas besoin d'activer les feuilles.
 

fanch55

XLDnaute Barbatruc
Bonjour,
code de remplacement à Tester :
VB:
Sub Creation_Fichier_UR()
'
'Pour eviter le message : qu'une fnom de colonne que je veux copier contient le nom "xxx" qui existe sur la feuille de destination.
'Voulez-vous utiliser cette version du nom ?" ma réponse est toujours oui.

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

'Deproteger
  Initialisation_Variables_Public
  Deverrouiller_feuille Onglet_Synthèse
 ' Fichier UR
 '----------
 'UR_Repertoire = "Z:\S3A - Documents de service\Procédures\MEQ Recherche\"
 'UR_Repertoire = [REP_BO_Extracion]
 AR_Repertoire = [Rep_BO_Extraction]
 AR_Fichier = [Fich_BO_Extraction]
 UR_Date = Format([Extract_Date], "dd/mm/yy")
 MsgBox " AR fichier : " & AR_Fichier & vbLf & vbLf & _
        " date extract : " & UR_Date

 Nb_Lig = [T_UR_Nom].Rows.Count
 For I = 1 To 2
    UR_Nomfichier = [T_UR_Nom[Nom_fichier]].Rows(I)
    Critere = [T_UR_Nom[sigles UR]].Rows(I)
    
    With Workbooks.Open(Filename:=[Rep_UR] & UR_Nomfichier & ".xlsm")  ' ouverture du fichier dans lequel on va copier une partie du fichier d'origine
        [T_Ur].Parent.Activate ' Activation de la feuille du tableau
        Deverrouiller_feuille ActiveSheet
            Onglet_Synthèse.[T_Ur2].AutoFilter Field:=1, Criteria1:=Critere
            Onglet_Synthèse.[T_Ur2[#Data]].SpecialCells(xlCellTypeVisible).Copy
            ActiveSheet.Paste [T_Ur[#Data]]
            [UR_Extract_Date] = UR_Date
        Verouiller_feuille ActiveSheet
        .Close saveChanges:=True
    End With
    
    'Fin fichier UR
    '--------------
Next
    
    Call Verouiller_feuille(Onglet_Synthèse)    ' unquement à la fin de la creation de tous les fichiers ?
    
    
Application.DisplayAlerts = True
Application.EnableEvents = True
MsgBox "Création terminée"
End Sub
 

Statistiques des forums

Discussions
313 257
Messages
2 096 610
Membres
106 682
dernier inscrit
faferrand