XL 2016 Copier coller en valeur après Offset

perr

XLDnaute Nouveau
Bonjour,

J'ai récupéré et adapté un code VBA
J'ai ajouté un code Inputbox pour obtenir le nombre de fichier à copier.

Le code ci-dessous me fait collage avec les formules.
je souhaiterais n'avoir qu'un collage en valeur.

J'ai essayé d'ajouter
.Select
Selection.PasteSpecial après Offset(1, 0) sans succès
idem avec .PasteSpecial (xlPasteValues)

Je vous remercie par avance pour votre aide précieuse.
A très bientôt


Sub copier()

Dim chemin$, i%
chemin = ThisWorkbook.Path & "\"
myNum = Application.InputBox("Enter le nombre de contrôle")
For i = 1 To myNum
Workbooks.Open chemin & "fichier " & i & ".xlsx"
ActiveWorkbook.Sheets("Liste générale de contrôle").Range(Cells(2, 1), Cells.SpecialCells(xlCellTypeLastCell).Address).Copy ThisWorkbook.Sheets("Total").Cells(Rows.Count, 1).End(3).Offset(1, 0)
ActiveWorkbook.Close False
Next
End Sub
 

Pièces jointes

  • Fichier 1.xlsx
    22.7 KB · Affichages: 13
  • Synthèse.xlsm
    970.4 KB · Affichages: 6
Dernière édition:
Solution
Bonjour,
Essaye comme ceci
VB:
Sub copier()
    Dim chemin$, i%, Derlg&
    chemin = ThisWorkbook.Path & "\"
    myNum = Application.InputBox("Entrer le nombre de contrôle", "Saisie", Type:=1)
    Application.ScreenUpdating = False: Application.EnableEvents = False
    For i = 1 To myNum
        Workbooks.Open chemin & "fichier " & i & ".xlsx"
        ActiveWorkbook.Sheets("Liste générale de contrôle").Range(Cells(2, 1), Cells.SpecialCells(xlCellTypeLastCell).Address).Copy
        Derlg = 2: On Error Resume Next: Derlg = ThisWorkbook.Sheets("Total").Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1: On Error GoTo 0
        ThisWorkbook.Sheets("Total").Range("a" & Derlg).PasteSpecial Paste:=xlPasteValues...

Jacky67

XLDnaute Barbatruc
Bonjour,

J'ai récupéré et adapté un code VBA
J'ai ajouté un code Inputbox pour obtenir le nombre de fichier à copier.

Le code ci-dessous me fait collage avec les formules.
je souhaiterais n'avoir qu'un collage en valeur.

J'ai essayé d'ajouter
.Select
Selection.PasteSpecial après Offset(1, 0) sans succès
idem avec .PasteSpecial (xlPasteValues)

Je vous remercie par avance pour votre aide précieuse.
A très bientôt


Sub copier()

Dim chemin$, i%
chemin = ThisWorkbook.Path & "\"
myNum = Application.InputBox("Enter le nombre de contrôle")
For i = 1 To myNum
Workbooks.Open chemin & "fichier " & i & ".xlsx"
ActiveWorkbook.Sheets("Liste générale de contrôle").Range(Cells(2, 1), Cells.SpecialCells(xlCellTypeLastCell).Address).Copy ThisWorkbook.Sheets("Total").Cells(Rows.Count, 1).End(3).Offset(1, 0)
ActiveWorkbook.Close False
Next
End Sub
Bonjour,
Essaye comme ceci
VB:
Sub copier()
    Dim chemin$, i%, Derlg&
    chemin = ThisWorkbook.Path & "\"
    myNum = Application.InputBox("Entrer le nombre de contrôle", "Saisie", Type:=1)
    Application.ScreenUpdating = False: Application.EnableEvents = False
    For i = 1 To myNum
        Workbooks.Open chemin & "fichier " & i & ".xlsx"
        ActiveWorkbook.Sheets("Liste générale de contrôle").Range(Cells(2, 1), Cells.SpecialCells(xlCellTypeLastCell).Address).Copy
        Derlg = 2: On Error Resume Next: Derlg = ThisWorkbook.Sheets("Total").Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1: On Error GoTo 0
        ThisWorkbook.Sheets("Total").Range("a" & Derlg).PasteSpecial Paste:=xlPasteValues
        ThisWorkbook.Sheets("Total").Range("a" & Derlg).PasteSpecial Paste:=xlPasteFormats
        Application.CutCopyMode = False
        ActiveWorkbook.Close False
        Application.EnableEvents = True
    Next
End Sub
 
Dernière édition:

perr

XLDnaute Nouveau
Bonjour,
Essaye comme ceci
VB:
Sub copier()
    Dim chemin$, i%, Derlg&
    chemin = ThisWorkbook.Path & "\"
    myNum = Application.InputBox("Entrer le nombre de contrôle", "Saisie", Type:=1)
    Application.ScreenUpdating = False: Application.EnableEvents = False
    For i = 1 To myNum
        Workbooks.Open chemin & "fichier " & i & ".xlsx"
        ActiveWorkbook.Sheets("Liste générale de contrôle").Range(Cells(2, 1), Cells.SpecialCells(xlCellTypeLastCell).Address).Copy
        Derlg = 2: On Error Resume Next: Derlg = ThisWorkbook.Sheets("Total").Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1: On Error GoTo 0
        ThisWorkbook.Sheets("Total").Range("a" & Derlg).PasteSpecial Paste:=xlPasteValues
        ThisWorkbook.Sheets("Total").Range("a" & Derlg).PasteSpecial Paste:=xlPasteFormats
        Application.CutCopyMode = False
        ActiveWorkbook.Close False
        Application.EnableEvents = True
    Next
End Sub
Bonsoir,
J'avais posté une demande le 8 juillet à laquelle vous avez la gentillesse de prendre le temps d'y répondre. j'étais passé à autre chose, les vacances sont passés par là.
j'ai repris le fichier cette semaine avec mes problématiques. j'étais content de tomber sur votre réponse.

Avec beaucoup de retard, je vous dis un grand merci.
la formule fonctionne parfaitement bien.

Merci encore!
 

Discussions similaires

Réponses
7
Affichages
404