Copier de classeur à classeur

[Florian53]

Bonjour à tous,

J'ai réalisé un Userform qui me permet d'aller chercher un classeur afin de copier la sheet (1) dans mon classeur active.

Pour cela j'ai crée une variable qui garde en mémoire le nom de mon classeur afin de pouvoir faire mon collage dessus.

La copie se réalise correctement par contre le code bug sur la déclaration de la variable, je ne vois pas d'ou vient le problème.

Quelqu'un aurait une piste ?

Sub OuvrirFichierExcelALOuverture()

    With UserForm2
   .Show
   End With
  
Set A_wbook = ActiveWorkbook.Name
        OuvertureFichiers MonRepertoire, MonFichier
     End Sub

[code]
Sub OuvertureFichiers(RepertoireFichier, NomFichier)

    ' Condition pour activer la macro
    For Each Wb In Workbooks
            Select Case Wb.Name
                Case NomFichier
                    Wb.Activate
                    Exit For
            End Select
    Next Wb
  
    Workbooks.Open Filename:=RepertoireFichier & "\" & NomFichier
    ' Copie la base de données
   Workbooks(NomFichier).Sheets(1).Range("A1:IV50000").Copy
   Workbooks("A_wbook" & ".xls").Activate
   Sheets("return").Activate
    Range("A1").Select
   Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
     Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
 
'***************************************
   ' Déclaration des variables
'***************************************
' Variable: P
'Sheets("return").Range("A3:A" & _
'Range("A65535").End(xlUp).Row).Name = "Manuf_Date"

' Variable: Q
'Sheets("return").Range("B3:B" & _
'Range("B65535").End(xlUp).Row).Name = "Base"

    End Sub

[/code]

 

[Robert]

Bonjour Florian, bonjour le forum,

Moi j'avoue ne pas comprendre ton code. Il ouvre une UserForm2 dont nous n'avons aucune trace...
je n'ai pas la réponse à ta question mais je te propose une autre solution avec le code ci-dessous :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (onglet Destination)
Dim FD As FileDialog 'déclare la variable FD (FileDialog)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OD (Onglet Source)

Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Worksheets("return") 'définit l'onglet destination OD
'définit la variable FD (la boîte de dialogue permettant de sélectionner le fichier source)
Set FD = Application.FileDialog(msoFileDialogFilePicker)
FD.AllowMultiSelect = False 'autorise la sélection d'un seul fichier
FD.Show 'affiche FD
If FD.SelectedItems.Count = 0 Then Exit Sub 'si aucun fichier sélectionné, sort de la procédure
Workbooks.Open FD.SelectedItems(1) 'ouvre le fichier sélectionné
Set CS = ActiveWorkbook 'définit le classeur source SC
Set OS = CS.Worksheets(1) 'définit l'onglet source OS
OS.Range("A1:IV50000").Copy OD.Range("A1") 'copie la plage A1:IV500 de l'onglet source et la colle dans A1 de l'onglet destination
CS.Close SaveChanges:=False 'ferme le classeur source (sans enregistrer)
End Sub

 

[Florian53]

Merci pour ta réponse voici en pièce jointe le fichier en question:

Je fais l'essai avec ta solution car je n'ai pas encore essayé

 

[Florian53]

J'ai voulu repartir de ton code afin de faire un coller en transposé, mais il bloque sur le Range de la fin, est ce que tu vois pourquoi ?

Sub OuvertureFichiers()
   
Dim CD As Workbook 'déclare la variable CD (classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (onglet Destination)
Dim FD As FileDialog 'déclare la variable FD (FileDialog)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OD (Onglet Source)

Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Worksheets("return") 'définit l'onglet destination OD
Sheets("return").Range("A1:Z2000").ClearContents
Sheets("return").Range("A1:Z2000").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
'définit la variable FD (la boîte de dialogue permettant de sélectionner le fichier source)
Set FD = Application.FileDialog(msoFileDialogFilePicker)
FD.AllowMultiSelect = False 'autorise la sélection d'un seul fichier
FD.Show 'affiche FD
If FD.SelectedItems.Count = 0 Then Exit Sub 'si aucun fichier sélectionné, sort de la procédure
Workbooks.Open FD.SelectedItems(1) 'ouvre le fichier sélectionné
Set CS = ActiveWorkbook 'définit le classeur source SC
Set OS = CS.Worksheets(1) 'définit l'onglet source OS
OS.Range("A1:IV50000").Copy OD.Range("A1") 'copie la plage A1:IV500 de l'onglet source et la colle dans A1 de l'onglet destination
Columns("A:A").Delete ' Suppression de la colonne après la copie
CS.Close SaveChanges:=False 'ferme le classeur source (sans enregistrer)
Sheets("return").Activate
Range(Cells(Range("A1").End(xlDown).Row, Range("A1").End(xlToRight).Column)).Select.Cut ' Couper pour coller en transposer
Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

End Sub

 

[Robert]

Re,

À partir du moment où tu as défini les onglets source et destination il te faut les spécifier quand tu désignes une plage !... Si j'ai bien compris, ton code simplifié devient :

Sub OuvertureFichiers()
 
Dim CD As Workbook 'déclare la variable CD (classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (onglet Destination)
Dim FD As FileDialog 'déclare la variable FD (FileDialog)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OD (Onglet Source)

Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Worksheets("return") 'définit l'onglet destination OD
With OD.Range("A1:Z2000")
  .ClearContents
  .Borders.LineStyle = xlNone
  .Pattern = xlNone
  .TintAndShade = 0
  .PatternTintAndShade = 0
End With
'définit la variable FD (la boîte de dialogue permettant de sélectionner le fichier source)
Set FD = Application.FileDialog(msoFileDialogFilePicker)
FD.AllowMultiSelect = False 'autorise la sélection d'un seul fichier
FD.Show 'affiche FD
If FD.SelectedItems.Count = 0 Then Exit Sub 'si aucun fichier sélectionné, sort de la procédure
Workbooks.Open FD.SelectedItems(1) 'ouvre le fichier sélectionné
Set CS = ActiveWorkbook 'définit le classeur source SC
Set OS = CS.Worksheets(1) 'définit l'onglet source OS
OS.Range("A1").CurrentRegion.Cut ' Couper pour coller en transposer
OD.Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
OD.Columns("A:A").Delete ' Suppression de la colonne après la copie
CS.Close SaveChanges:=False 'ferme le classeur source (sans enregistrer)
End Sub

 

[Florian53]

Merci Robert,

Une belle simplification de code

J'ai une erreur à la fin du code sur la ligne PasteSpecial , il m'indique "la méthode pastespecial de la classe range a échoué"

La cellule est bien sélectionné mais le collage ne se fait pas. J'ai essayé de mettre le transpose sur false mais ça ne fonctionne pas non plus

 

[Robert]

Re,

Visiblement c'est le Cut qui pose problème !... Je découvre aussi... En plus, si on n'enregistre pas en fermant le classeur source il ne sert à rien.
Si tu veux vraiment vider la classeur source il faudra modifier à la fin de la macro :

OS.Range("A1").CurrentRegion.EntireRow.Delete
CS.Close SaveChanges:=True 'ferme le classeur source (en enregistrant)

Sinon, le code modifié qui fonctionne :

Sub OuvertureFichiers()
Dim CD As Workbook 'déclare la variable CD (classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (onglet Destination)
Dim FD As FileDialog 'déclare la variable FD (FileDialog)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim PL As Range
Dim TV As Variant

Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Worksheets("return") 'définit l'onglet destination OD
With OD.Range("A1:Z2000")
  .ClearContents
  .Borders.LineStyle = xlNone
  .Interior.Pattern = xlNone
  .Interior.PatternTintAndShade = 0
End With
'définit la variable FD (la boîte de dialogue permettant de sélectionner le fichier source)
Set FD = Application.FileDialog(msoFileDialogFilePicker)
FD.AllowMultiSelect = False 'autorise la sélection d'un seul fichier
FD.Show 'affiche FD
If FD.SelectedItems.Count = 0 Then Exit Sub 'si aucun fichier sélectionné, sort de la procédure
Workbooks.Open FD.SelectedItems(1) 'ouvre le fichier sélectionné
Set CS = ActiveWorkbook 'définit le classeur source SC
Set OS = CS.Worksheets(1) 'définit l'onglet source OS
OS.Range("A1").CurrentRegion.Copy
OD.Range("A1").PasteSpecial xlPasteAll, Transpose:=True
OD.Columns("A:A").Delete ' Suppression de la colonne après la copie
CS.Close SaveChanges:=False 'ferme le classeur source (sans enregistrer)
End Sub

 

[Florian53]

Super, un grand merci à toi .

A bientot