Code VB pour copier coller "Valeurs"

Bonjour et bonne année à tous.

Dans le fichier joint ( c'est un fichier allégé), j'aurai besoin d'un code VB , qui copie les valeurs des lignes 'NbPostesPDP" ( en jaune dans le fichier), à partir de la colonne K jusqu'en colonne BA, et qu'il les colle en format valeur.

De temps en temps dans ces cellules , j'y mets une formule qui va rechercher dans un autre fichier des valeurs, et donc en ensuite je souhaite revenir dans un format Valeur et non plus une formule.

En espérant que ma demande est claire.

merci de votre aide

Bonjour,

Une proposition à étudier.

Ctrl + m pour exécuter la procédure.

Cdlt.

Option Explicit
'Ctrl+m pour lancer la procédure.
Public Sub Copy_values()
Dim lastRow As Long, rng As Range, c As Range
Dim firstAddress As String
Const TXT As String = "NbPostesPDP"
    With ActiveSheet
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rng = .Cells(10).Resize(lastRow)
    End With
    With rng
        Set c = .Find(what:=TXT, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.Offset(, 1).Resize(, 18).Value = c.Offset(, 1).Resize(, 18).Value
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Sub

Merci Jean Eric

mais quand je fais Ctrl+M, cela ne fonctionne pas

Est il possible d'associer le code à un bouton.

Merci de ton aide

Re,

Cela ne fonctionne pas ?

Mets des formules et effectue Ctrl + m. ou ALT F8 et exécute l'unique procédure du classeur.

Les formules sont supprimées et on ne conserves que les les valeurs.

Cdlt.

Jean Eric

La procédure à l'air de fonctionner, mais elle est extrêmement longue.

la feuille concernée a plus de 3800 lignes.

Y a t il un moyen que cela soit plus rapide..Cdt

Bonjour Fred, Jean-Eric,

je te retourne ton fichier modifié :

Ctrl e ➯ travail effectué

Alt F11 pour voir le code VBA, puis revenir sur Excel

si besoin, tu peux demander une adaptation.

merci de me dire si ça te convient.

dhany

Bonjour Dhany et Jean Eric

La procédure fonctionne, mais elle est tout aussi longue.

Une procédure, telle que si l'on sélectionne toutes les lignes concernées et que l'on fasse un copier-coller valeurs , ne serait elle pas plus rapide à l'exécution.

Merci de vos réponses.

Cdt.

Bonjour,

C'est quoi long pour toi ?

Cdlt.

Bonjour Eric

Plus de 15 mn !

Fred56 a écrit :

Bonjour Eric

Plus de 15 mn !

Bonjour,

Une piste pour accélérer l'exécution :

Application.Calculation = xlCalculationManual 'Ajouter en début de procédure
'LeCode
Application.Calculation = xlCalculationAutomatic 'Ajouter en fin de procédure

Bonjour,

Bon si on considère que tu as des MFCs, que ta feuille affiche les sauts de page, un grand nombre de formules, etc...

A tester et me redire.

Option Explicit
'Ctrl+m pour lancer la procédure.
Public Sub Copy_values()
Dim lastRow As Long, i As Long
Dim tbl As Variant
Const TXT As String = "NbPostesPDP"
Dim bln As Boolean
Dim t As Single
    t = Timer
    Excel_Settings False
    With ActiveSheet
        bln = .DisplayPageBreaks
        .DisplayPageBreaks = False
        lastRow = .Cells(.Rows.Count, 10).End(xlUp).Row
        tbl = .Cells(10).Resize(lastRow)
        For i = 1 To UBound(tbl)
            If tbl(i, 1) = TXT Then
                .Cells(i, 11).Resize(, 18).Value = .Cells(i, 11).Resize(, 18).Value
            End If
        Next i
        .DisplayPageBreaks = bln
    End With
    Excel_Settings True
    MsgBox Format(Timer - t, "0.00") & " seconde(s)"
End Sub

Private Function Excel_Settings(bln As Boolean, Optional ws As Worksheet = Nothing)
Dim blnEvent As Boolean
    If ws Is Nothing Then Set ws = ActiveSheet
    With Application
        .ScreenUpdating = bln
        .DisplayAlerts = bln
        .Interactive = bln
        .EnableEvents = bln
    End With
    ws.EnableFormatConditionsCalculation = bln
    If bln = False Then Application.Calculation = xlCalculationManual
    If bln = False Then Application.Cursor = xlWait
    If bln = True Then Application.Calculation = xlCalculationAutomatic
    If bln = True Then Application.Cursor = xlDefault
End Function

Bonjour,

Fred56 a écrit :

Plus de 15 mn !

ah, alors tout s'explique : c'est son ordi qui fait une grève perlée ! bon, si c'est pas ça, y'a p't'être un virus qui ralentit son ordi ? ou c'est sa bécane qui est trop ancienne, avec un vieux processeur poussif ? ou c'est une foutue mise à jour Crosoft pourrie qui fait qu'ça rame allègrement ? vive les mises à jour Crosoft bâclées et boguées !

bonne chance !

dhany

Bonjour

essayez ceci:

Option Explicit

Sub copier_val()

With ThisWorkbook.Worksheets("Feuil1")

.Range("K:T").Copy

.Range("U1").PasteSpecial Paste:=xlValues

End With

End Sub

Bonjour Et-Hyene,

j'ai l'impression qu't'as pas bien lu l'énoncé, ni ouvert le fichier ! ton code VBA fait comment,

pour copier les valeurs des seules lignes jaunes qui contiennent "NbPostesPDP" ?

pa'c'que là, c'est les colonnes K à T entières !

dhany

oups j'avais pas compris pardon essayez ceci:

Sub copier_val()

Dim n As Integer

With ThisWorkbook.Worksheets("Feuil1")

For n = 0 To 6

.Range("K" & 29 + 16 * n & ":T" & 29 + 16 * n).Copy

.Range("U" & 29 + 16 * n).PasteSpecial Paste:=xlValues

Next

End With

End Sub

ah oui, c'est mieux ! tu peux même utiliser une variable pour calculer une seule fois le bon n° de ligne :

Sub copier_val()
  Dim n As Integer, v As Integer
  With ThisWorkbook.Worksheets("Feuil1")
    For n = 0 To 6
      v = 29 + 16 * n
      .Range("K" & v).Resize(, 10).Copy
      .Range("U" & v).PasteSpecial Paste:=xlValues
    Next n
  End With
End Sub

note aussi le .Resize() avec 10 en 2ème argument ; de K à T, y'a bien 10 colonnes en tout ; et si y'a vraiment beaucoup de lignes, il vaudra mieux utiliser le type Long au lieu de Integer, sinon plantage à partir de la ligne n° 32 768 !

perso, j'me suis pas servi d'cet écart constant au cas où ça serait différent dans l'fichier réel du demandeur.

dhany

Bonsoir à tous,

Via la fonction Filter, on peut aussi récupérer les numéros de lignes.

With Sheets("Feuil1").Range("j1:j134")
    x = Filter(Evaluate("transpose(if(" & .Address & _
                      "=""NbPostesPDP"",row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
End With

klin89