Sélection d'une plage de cellules

[taratata]

Bonjour,

Dans un tableau structuré, j'ai besoin de reproduire ce que l'on peut faire via la souris via VBA code
- Sélectionner la cellule Source (ex: I30)
- Remplir une plage de cellules (en se servant du pt. carrée en bas à dtr. du rectangle de sélection
- Etirer jusqu'à une cellule destination (ex : I31)

de plus la cellule Source est une variable, donc la cellule destination sera aussi variable

J'ai essayé plusieurs écriture sans succès.

voici le code

        Dim Feuille As Worksheet
        Dim list_obj As ListObject
        Dim list_row As ListRow
        
        Set Feuille = Sheets("Stock")
        Set list_obj = Feuille.ListObjects(Nom_Tableau)
        Set list_row = list_obj.ListRows.Add
        
        Last_Line = list_obj.Range.Rows.Count
    
        
        list_row.Range(Last_Line - 1, 9).Select           ' sélection de la cellule source
        Selection.Copy
        
        ' ligne pour sélectionner la plage pour copy
        
        'list_row.Range("J" & Last_Line - 1 & ":" & "J" & Last_Line).Select
        'list_row.Range(Cells(9, (Last_Line - 1)), Cells(9, Last_Line)).Select

        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False

merci pour votre temps

 

[Jean-Eric]

Bonjour,
Une proposition à étudier.
Cdlt.

Public Sub InsertRowInTable()
Dim lr As ListRow, rCell As Range
    If Not ActiveCell.ListObject Is Nothing Then
        With ActiveCell.ListObject
            If .InsertRowRange Is Nothing Then
                Set rCell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
                Set lr = .ListRows(ActiveCell.Row - .HeaderRowRange.Row)
                lr.Range.Copy Destination:=rCell
            End If
        End With
    End If
End Sub

 

[taratata]

merci Jean-Eric

J'ai autrement en incorporent la formule dans la macro.
Elle fonctionnement est bon, dans le sens qu'elle alloue la valeur de la nouvelle cellule à tester.

Par contre j'ai une erreur "propriété ou méthode non gérée par cet objet

voici le code

Option Explicit

Sub test_0()
        Dim Feuille As Worksheet
        Dim list_obj As ListObject
        Dim list_row As ListRow
        
        Set Feuille = Sheets("Sheet1")
        Set list_obj = Feuille.ListObjects("Table1")
        
        Dim last_line As Integer
        last_line = list_obj.Range.Rows.Count
        MsgBox last_line
        
list_obj.Range(last_line + 1, 5) = "05.05.2020"
list_obj.Range(last_line, 6).Copy list_obj.Range(last_line + 1, 6)
With list_obj
            .FormulaR1C1 = "=SI($G" & last_line & ">AUJOURDHUI();" & "Valide" & ";" & "Périmé" & ")"
            .Copy list_obj.Range(last_line + 1, 6)
End With

End Sub

dans la formule, la cellule à tester est une variable last_line

une idée s'il vous plaît
merci de votre temps

 

[Jean-Eric]

Bonjour,
Pour commencer, les formules d'un tableau structurées sont reconduites automatiquement lors de l'ajout de lignes, tout comme la mise en forme des cellules, ou encore les MFCs (mise en forme conditionnelles).
La procédure, de ce que je comprends, pourrait être simplement :

Public Sub InsertRowInTable()
Dim lr As ListRow, rCell As Range
    If Not ActiveCell.ListObject Is Nothing Then
        With ActiveCell.ListObject
            If .InsertRowRange Is Nothing Then
                Set rCell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
                Set lr = .ListRows(ActiveCell.Row - .HeaderRowRange.Row)
                lr.Range.Copy Destination:=rCell
                rCell.Offset(, 4).Value = "05/05/2020"
            End If
        End With
    End If
End Sub

 

[Staple1600]

Bonjour

Je te laisse faire les tests en t'inspirant des deux exemples de syntaxe ci-dessous

Sub test_formules()
Dim last_line$
last_line = 1
[A1].Formula = "=IF($G" & last_line & ">TODAY(),""Valide"",""Périmé"")"
[A2].FormulaR1C1 = "=IF(R" & last_line & "C7>TODAY(),""Valide"",""Périmé"")"
End Sub

EDITION: Bonjour Jean-Eric
(Désolé, je n'ai pas rafraîchi la page avant de poster)

 

[taratata]

merci Staple1600

le test fonctionne.

je pense que je fais fausse route.

car parfois, sur une des tableaux structurés la cellule contenant la formule n'est pas répliquée lors de l'ajout d'une nouvelle ligne lors
de l'écriture des diverses valeur des autres cellules de cette même nouvelle ligne.

 

[Jean-Eric]

Re,
Peux-tu me faire un retour sur ma proposition ?
Cdlt.

 

[taratata]

Jean-Eric,

je galère sur ce prob.
je vais prendre du recule ... pour y voir plus clair

merci