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

[anbar]

Bonjour


Je voudrais bien savoir si vous pouvez m'aider à faire un code vba pour copier uniquement les colonnes et les lignes non vides d'une feuille à l'autre dans un même classeur.
Ci-joint le classeur contenant un tableau en exemple.

Merci pour tout le monde.

 

[Dranreb]

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.

 

[anbar]

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.

Je m'excuse j'ai pas bien poser le problème, en fait je voulais dire les lignes et colonnes qui ne contiennent pas de valeurs.
car je dois absolument garder les noms des lignes et colonnes pour autres utilisations.
Merci

 

[job75]

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 :

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+

 

[anbar]

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 :

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+

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

 

[anbar]

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

Re
Je voudrais savoir si c'est possible de s’arrêter à la ligne 20 cad ne pas copier au delà de la ligne 20 car tout ce que je saisi en dessous du tableau de la feuille1 est copié quand j'active la 2eme feuille

Merci

 

[job75]

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

Fichier (2) avec cette nouvelle macro :

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+

 

[anbar]

Fichier (2) avec cette nouvelle macro :

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+

Merci
Rien à dire c'est bien fait.
Merci à tous