XL 2010 vba pour copier une plage de cellules variable

[anbar]

Bonjour tout le monde

J'ai un tableau composé de 2 parties la première est reversée aux articles ACIER en l’occurrence la plage de cellules (A2:A11) et la parie
ALU composée de la plage de cellules (A13:A20).
Sachant que les deux plages sont variables de vue nombre de lignes c'est à dire que la prière page peut passer de (A2:A11) à (A2:A20) par exemple
il y a que la 1ere ligne qui ne change pas et idem pour la 2eme partie ALU.

J'ai nommé la ligne 12 ALU ET LA LIGNE 22 (CHANTIER) car il peut y avoir une 3eme partie du tableau.

Ma question est don est savoir s'il y a moyen de copier (code vba) par exemple la 1ere partie du tableau de la feuille 1 dans la feuille 2
en prenant la dernière ligne par son nom (ligne ALU) comme ce même si le nombre de lignes changent toute les données seront copiées.

Merci à vous tous
ci-joint un fichier test

 

[job75]

Bonjour anbar,

Exécutez cette macro :

Sub Copier_ACIER()
Application.ScreenUpdating = False
On Error Resume Next 'sécurité
Rows(1).Insert 'insère une ligne pour décaler le tableau
With Feuil2 'CodeName de la feuille de destination
    .Cells.Delete 'RAZ
    Range(Cells.Find("ACIER", , xlValues).MergeArea, Cells.Find("ALU")(0)).Copy .[A1]
    .Activate 'facultatif
End With
Rows(1).Delete 'supprime la ligne insérée
End Sub

A+

 

[laurent3372]

J'ai été doublé par @job75

Voici ma solution qui suppose qu'on insère une ligne vide avant chaque titre de section.
On peut passer une variable en paramètre à la fonction.

Option Explicit
Private Sub CommandButton1_Click()
    Worksheets("Feuil2").UsedRange.ClearContents        'On effaca le contenu
    getRange("ALU", 11).Copy Destination:=Worksheets("Feuil2").Range("A1")
End Sub

Function getRange(name As String, nbCol As Long) As Range
    Dim derLigne As Range
    
    Set getRange = Range(name).Resize(1, 1)
    Set derLigne = getRange.End(xlDown)
    Set getRange = getRange.Resize(derLigne.Row - getRange.Row + 1, nbCol)
End Function

 

[job75]

Bien sûr avec les lignes nommées Acier et ALU c'est bien plus simple :

Sub Copier_ACIER()
With Feuil2
    .Cells.Delete 'RAZ
    On Error Resume Next 'sécurité
    Range([Acier], [ALU].Offset(-1)).Copy .[A1]
    .Activate 'facultatif
End With
End Sub

Bonjour laurent3372.

 

[anbar]

Bonjour anbar,

Exécutez cette macro :

Sub Copier_ACIER()
Application.ScreenUpdating = False
On Error Resume Next 'sécurité
Rows(1).Insert 'insère une ligne pour décaler le tableau
With Feuil2 'CodeName de la feuille de destination
    .Cells.Delete 'RAZ
    Range(Cells.Find("ACIER", , xlValues).MergeArea, Cells.Find("ALU")(0)).Copy .[A1]
    .Activate 'facultatif
End With
Rows(1).Delete 'supprime la ligne insérée
End Sub

A+

Un grand merci Job75 c'est efficace.
Bonne fin de soirée

 

[anbar]

J'ai été doublé par @job75

Voici ma solution qui suppose qu'on insère une ligne vide avant chaque titre de section.
On peut passer une variable en paramètre à la fonction.

Option Explicit
Private Sub CommandButton1_Click()
    Worksheets("Feuil2").UsedRange.ClearContents        'On effaca le contenu
    getRange("ALU", 11).Copy Destination:=Worksheets("Feuil2").Range("A1")
End Sub

Function getRange(name As String, nbCol As Long) As Range
    Dim derLigne As Range
   
    Set getRange = Range(name).Resize(1, 1)
    Set derLigne = getRange.End(xlDown)
    Set getRange = getRange.Resize(derLigne.Row - getRange.Row + 1, nbCol)
End Function

Bonsir Laurent3372 , j'avoue que j'ai été gâté par toi et Job75
Merci pour ton aide et bonne fin de soirée.