Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

copie et remplissage tableau

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
A

alessandro

XLDnaute Occasionnel
Bonjour tout le monde, je débute en VBA et voici mon pb:
J'ai un tableau rempli totalement avec des cellules pleines et des cellules vides. les pleines sont des X
Je voudrai créer une macro qui parcours ce tableau et chaque fois qu'elle rencontre une cellule avec X elle me fasse une copie des 3 premières cellules comprises sur la même ligne dans une nouvelle feuille + copier le nombre de colonne active
qui correspone a la semaine de visite.
piece jointe pour voir ce que je voudrai
merci
Alessandro
 

Pièces jointes

Trier par date Trier par votes
Re : copie et remplissage tableau

bonjour
j'ai du code "généraliste" pour ce genre de situation qui revient souvent, généraliste: ça fonctionne quelle que soit le nb de lignes et/ou col d'infos relatives aux data du table
il faut se placer sur la cellule en haut à gauche du tableau contenant les données (D3) dans ton cas

à adapter
à+

With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With

t1 = Now


With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False


Application.ScreenUpdating = False


feuille_source = ActiveSheet.Name

Sheets.Add

nouvelle_feuille = ActiveSheet.Name

Sheets(feuille_source).Select

'sélectionner la première donnée

ligne = ActiveCell.Row
colonne = ActiveCell.Column


nb_lignes = ligne - 1
nb_colonne = colonne - 1

'nb total de colonnes
n1 = 0
For i = 1 To nb_lignes
n2 = Cells(i, 255).End(xlToLeft).Column
If n2 > n1 Then n1 = n2
Next i

nb_total_colonne = n1 - nb_colonne


'nb total de lignes
n1 = 0
For i = 1 To nb_colonne
n2 = Cells(65536, i).End(xlUp).Row
If n2 > n1 Then n1 = n2
Next i

nb_total_ligne = n1 - nb_lignes


'''''''''''''''''''''''''''''''''''''''''''''''''''
compteur = 1
'''''''''''''''''''''''''''''''''''''''''''''''''''

'boucle avançant sur les colonnes

For maligne = ligne To nb_total_ligne + nb_lignes
'maligne = ligne

For a = colonne To nb_total_colonne + nb_colonne

If Cells(maligne, a) <> 0 And Cells(maligne, a) <> "" Then

For boucle = 1 To nb_colonne
Sheets(nouvelle_feuille).Cells(compteur, boucle) = Cells(maligne, boucle)
Next boucle
For boucle2 = 1 To nb_lignes
Sheets(nouvelle_feuille).Cells(compteur, boucle2 + nb_colonne) = Cells(boucle2, a) 'boucle)
Next boucle2

Sheets(nouvelle_feuille).Cells(compteur, nb_colonne + nb_lignes + 1) = Cells(maligne, a)


compteur = compteur + 1

End If





Next a
'r = Range("A65536").End(xlUp).Row + 1
'c= Range("IV1").End(xlToLeft).Column

Next maligne


Sheets(nouvelle_feuille).Select

With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False

t = Int((Now - t1) * 24 * 3600 * 10) / 10
 
Vote positif 0 Vote négatif
Re : copie et remplissage tableau

Bonjour alessandro, nicopec, Pierre,

Dans le code de la feuille "Foglio2" :

Code: 
Private Sub Worksheet_Activate()
Dim P As Range, t, ncol%, rest(), n&, i&, j%
With Foglio1 'CodeName, à adapter
  Set P = .Range("A2:BC" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
t = P 'matrice, plus rapide
ncol = UBound(t, 2)
ReDim rest(1 To 2 * Application.CountIf(P.Offset(, 3), "X") + 1, 1 To 4)
n = -1
For i = 2 To UBound(t)
  For j = 4 To ncol
    If t(i, j) = "X" Then
      n = n + 2
      rest(n, 1) = t(i, 1): rest(n, 2) = t(i, 2): rest(n, 3) = t(i, 3)
      rest(n, 4) = t(1, j)
    End If
Next j, i
If n > 0 Then [A2].Resize(n, 4) = rest
Range("A" & n + 3 & ":D" & Rows.Count).Delete xlUp
End Sub
La macro se déclenche quand on active la feuille.

Fichier joint.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

S
  • Résolu(e)
XL 2010 tableau de cumul automatisé
Réponses
13
Affichages
724
stefiskool
S
D
  • Résolu(e)
Microsoft 365 Macro pour rafraîchir les liaisons
Réponses
11
Affichages
753
AtTheOne
A
  • Question Question
Autres Copie avec incrémentation de cellules de type =$A$nn
Réponses
6
Affichages
247
sylvanu
Z
  • Question Question
Microsoft 365 Mise en forme de tableau et répétition de formule
Réponses
2
Affichages
619
DJunqueira
D
L
  • Résolu(e)
XL 2016 Problème liaison USF vers tableau et inversément
Réponses
1
Affichages
620
Ludo G
L
M
  • Résolu(e)
Microsoft 365 enregistrement copie du classeur ouvert avec mot de passe et incrémentation
2
Réponses
27
Affichages
2 K
meyscal
M
V
  • Question Question
XL 2016 Convertir en tableau
Réponses
6
Affichages
823
cp4
  • Question Question
XL 2016 Copier le tableau à la suite en gardant la mise en page et en modifiant la date
Réponses
7
Affichages
837
dindin
J
  • Question Question
XL 2016 Regrouper automatiquement les cellules en supprimant les cellules sans affichage, colonne par colonne
Réponses
4
Affichages
907
jt25410
J
  • Question Question
XL 2019 Bouton pour impression dynamique
Réponses
6
Affichages
827
My<3
N
  • Question Question
XL 2016 Moyenne des x dernières notes
Réponses
13
Affichages
1 K
mapomme
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
2 K
ERIC S
M
  • Question Question
Microsoft 365 Tri de colonnes avec 3 critères, remplissage de lignes vides avec formule + ventilation vers autre onglet
Réponses
8
Affichages
2 K
marinehaye
M
C
  • Résolu(e)
Microsoft 365 Macro archiver et générer nouveau document vierge
Réponses
4
Affichages
1 K
chris63*
C
A
  • Résolu(e)
Microsoft 365 Remplir un tableur Excel a partir d'un document Word
Réponses
2
Affichages
3 K
Azuveus
A
K
  • Question Question
Microsoft 365 Alerte après quatorzaine et trentaine
Réponses
3
Affichages
822
Jocelyn
C
  • Résolu(e)
Microsoft 365 Extraire dans plusieurs colonnes les données d'une autre feuille en sautant des lignes et sans macro
Réponses
4
Affichages
3 K
Caillou_
C
D
  • Question Question
Microsoft 365 Compléter un tableau de suivi automatiquement et bien compliqué :-)
Réponses
1
Affichages
2 K
herve62
N
  • Question Question
XL 2016 TdB formule
Réponses
5
Affichages
2 K
nanajw
N
J
  • Question Question
Aide pour comparer deux listes et remplir un tableau en conséquence
Réponses
5
Affichages
2 K
Jorgio
J
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…