VBA POUR COPIER UNIQUEMENT LES COLONNES ET LES LIGNES CONTENAT DES VALEURS

Dranreb à dit:

Bonjour.
Le problème c'est que jusqu'à la cellule AR10 de votre 1ère feuille il n'y a ni ligne vide ni colonne vide.
Il y a toujours quelque chose dans la 1ère ligne et dans la 1ère colonne.

Cliquez pour agrandir...

job75 à dit:

Bonjour anbar, Bernard,

Oui je comprends que pour les "vides" il faut ignorer les titres.

Voyez le fichier joint et cette macro dans le code de Feuil2 :

Code:

Private Sub Worksheet_Activate()
Cells.Delete 'RAZ
On Error Resume Next 'si aucune SpecialCell
With Feuil1.UsedRange.Offset(1).SpecialCells(xlCellTypeConstants) 'Feuil1 => CodeName
    Intersect(.Cells(0, 1).EntireRow, .EntireColumn).Copy [A1] 'titres
    Intersect(.EntireRow, .EntireColumn).Copy [A2]
End With
With UsedRange: End With 'actualise les barres de défilement
End Sub

Elle se déclenche quand on active la feuille.

A+

Cliquez pour agrandir...

anbar à dit:

Merci pour votre aide
Ca marche très très bien
Merci

Cliquez pour agrandir...

anbar à dit:

Je voudrais savoir si c'est possible de s’arrêter à la ligne 20

Cliquez pour agrandir...

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Cells.Delete 'RAZ
On Error Resume Next 'si aucune SpecialCell
With Feuil1.UsedRange.Offset(1).Resize(19).SpecialCells(xlCellTypeConstants) 'Feuil1 => CodeName
    [A1].ColumnWidth = .Parent.UsedRange.Cells(1).ColumnWidth 'largeur de la 1ère colonne
    Intersect(.Cells(0, 1).EntireRow, .EntireColumn).Copy [A1] 'titres
    Intersect(.EntireRow, .EntireColumn).Copy [A2]
End With
With UsedRange: End With 'actualise les barres de défilement
End Sub

job75 à dit:

Fichier (2) avec cette nouvelle macro :

Code:

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Cells.Delete 'RAZ
On Error Resume Next 'si aucune SpecialCell
With Feuil1.UsedRange.Offset(1).Resize(19).SpecialCells(xlCellTypeConstants) 'Feuil1 => CodeName
    [A1].ColumnWidth = .Parent.UsedRange.Cells(1).ColumnWidth 'largeur de la 1ère colonne
    Intersect(.Cells(0, 1).EntireRow, .EntireColumn).Copy [A1] 'titres
    Intersect(.EntireRow, .EntireColumn).Copy [A2]
End With
With UsedRange: End With 'actualise les barres de défilement
End Sub

A+

Cliquez pour agrandir...