XL 2016 Copier une plage d'une feuille Excel à une autre en tant que valeurs sans formatage

[Dadi147]

Bonjour, je veux copier la feuille de données1 pleurant de la cellule ("a5:v" & lr) et la copier dans la feuille2 ("a9:v") La copie est toujours sous la dernière ligne avec des données feuille2 colonne A

 

[sylvanu]

Bonjour Dadi,
Un essai en PJ avec :

Sub copie()
tablo = Sheets("sh").[A5].CurrentRegion
N = [Tableau334].Rows.Count
With Sheets("sh1").Cells(N + 4, "A")
    .Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo
    .Delete
End With
End Sub

 

[Dadi147]

Bonjour Dadi,
Un essai en PJ avec :

Sub copie()
tablo = Sheets("sh").[A5].CurrentRegion
N = [Tableau334].Rows.Count
With Sheets("sh1").Cells(N + 4, "A")
    .Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo
    .Delete
End With
End Sub

Merci, mais je veux qu'il copie les données dans la dernière ligne avec une valeur dans la colonne a lastrow colonne a

 

[sylvanu]

Merci, mais je veux qu'il copie les données dans la dernière ligne avec une valeur dans la colonne a lastrow colonne a

Franchement pas compris.
Donnez un ex avec votre fichier car ça, je ne comprends pas : "une valeur dans la colonne a lastrow colonne a"

 

[Dadi147]

Je veux dire que les lignes sont copiées dans la dernière ligne avec une valeur dans une colonne a feuil1
Si la colonne est vide, le reste des lignes inférieures est ignoré

 

[sylvanu]

Donnez un ex avec votre fichier

 

[Dadi147]

Je veux dire que les lignes sont copiées dans la dernière ligne avec une valeur dans une colonne a feuil1
Si la colonne est vide, le reste des lignes inférieures est ignoré

 

[sylvanu]

C'est plus explicite ainsi, ... et j'en étais loin. 🙂

Sub copie()
With Sheets("sh")
    DL = [Tableau1].Rows.Count
    For L = DL To 5 Step -1
        If .Cells(L, "A") <> "" Then Exit For
    Next L
    tablo = .Range("A5:V" & L + 1)
End With
N = [Tableau334].Rows.Count
With Sheets("sh1").Cells(N + 4, "A")
    .Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo
End With
End Sub

 

[job75]

Bonsoir Dadi147, sylvanu,

Une autre solution :

Sub copie()
Dim P As Range
With [Tableau1]
    With .ListObject.Range: .AutoFilter: .AutoFilter: End With 'si le tableau est filtré
    If Application.CountA(.Columns(1)) Then If .Cells(.Rows.Count, 1) = "" Then _
        Set P = .Rows(1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - .Row + 1) Else Set P = .Cells
End With
With [Tableau334]
    With .ListObject.Range: .AutoFilter: .AutoFilter: End With 'si le tableau est filtré
    If .Rows.Count > 1 Then .Rows(2).Resize(.Rows.Count - 1).Delete xlUp 'RAZ
    If P Is Nothing Then .Rows(1) = "" Else P.Copy .Cells(1)
    .Parent.Activate 'facultatif
End With
End Sub

A+

 

[Dadi147]

Bonsoir Dadi147, sylvanu,

Une autre solution :

Sub copie()
Dim P As Range
With [Tableau1]
    With .ListObject.Range: .AutoFilter: .AutoFilter: End With 'si le tableau est filtré
    If Application.CountA(.Columns(1)) Then If .Cells(.Rows.Count, 1) = "" Then _
        Set P = .Rows(1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - .Row + 1) Else Set P = .Cells
End With
With [Tableau334]
    With .ListObject.Range: .AutoFilter: .AutoFilter: End With 'si le tableau est filtré
    If .Rows.Count > 1 Then .Rows(2).Resize(.Rows.Count - 1).Delete xlUp 'RAZ
    If P Is Nothing Then .Rows(1) = "" Else P.Copy .Cells(1)
    .Parent.Activate 'facultatif
End With
End Sub

A+

Oui, mais lors de la recopie, les anciennes données sont copiées
Les anciennes données doivent être conservées et les nouvelles copies en dessous

 

[job75]

Bonjour Dadi147,

Les anciennes données doivent être conservées et les nouvelles copies en dessous

Alors utilisez :

Sub copie()
Dim P As Range, h&
With [Tableau1]
    With .ListObject.Range: .AutoFilter: .AutoFilter: End With 'si le tableau est filtré
    If Application.CountA(.Columns(1)) Then If .Cells(.Rows.Count, 1) = "" Then _
        Set P = .Rows(1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - .Row + 1) Else Set P = .Cells
End With
With [Tableau334]
    With .ListObject.Range
        .AutoFilter: .AutoFilter 'si le tableau est filtré
        h = .Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row - .Row + 1
        If h = 1 Then .Rows(2) = "" Else If h < .Rows.Count Then .Rows(h + 1).Resize(.Rows.Count - h).Delete 'RAZ en dessous
        If Not P Is Nothing Then P.Copy .Cells(h + 1, 1)
        .Parent.Activate 'facultatif
    End With
End With
End Sub

A+