Programme VBA
jacksa3ada
Messages postés
36
Date d'inscription
Statut
Membre
Dernière intervention
-
yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention -
yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
je désire copie les valeurs se trouvant dans les mèmes cellules des feuilles d'un classeur excel
j ai le programme qui copie ces valeurs dans une feuille appeler TABLEAU
le programme marche très bien
MAIS!!
lorsque je supprime les feuilles (sauf la feuille 'TABLEAU') et je ramène d'autre feuille
le programme copie sur les donnes et écrase celle existante
je veux le modifie pour coller les nouvelles donnes a chaque fois en bas de tableau ou a la première ligne de tableau
y a t-il un moyen??
voici le PROGRAME
ACUALISER
' Dim Wsh As Worksheet, FeuilRecap As Worksheet, k As Integer
Set FeuilRecap = Worksheets("TABLEAU") 'feuille ou coller
k = 2 'autant débuter le "collage" à la seconde ligne
'boucle sur toutes les feuilles du classeur
For Each Wsh In ThisWorkbook.Worksheets
'Si la feuille (en cours dans la boucle) n'est pas la feuille récap alors
If Not Wsh Is FeuilRecap Then
'copié-collé
Wsh.Range("i1:v1").Cut FeuilRecap.Rows(k)
'ligne suivante pour le collage
k = k + 1
End If
Next Wsh
End Sub
je désire copie les valeurs se trouvant dans les mèmes cellules des feuilles d'un classeur excel
j ai le programme qui copie ces valeurs dans une feuille appeler TABLEAU
le programme marche très bien
MAIS!!
lorsque je supprime les feuilles (sauf la feuille 'TABLEAU') et je ramène d'autre feuille
le programme copie sur les donnes et écrase celle existante
je veux le modifie pour coller les nouvelles donnes a chaque fois en bas de tableau ou a la première ligne de tableau
y a t-il un moyen??
voici le PROGRAME
ACUALISER
' Dim Wsh As Worksheet, FeuilRecap As Worksheet, k As Integer
Set FeuilRecap = Worksheets("TABLEAU") 'feuille ou coller
k = 2 'autant débuter le "collage" à la seconde ligne
'boucle sur toutes les feuilles du classeur
For Each Wsh In ThisWorkbook.Worksheets
'Si la feuille (en cours dans la boucle) n'est pas la feuille récap alors
If Not Wsh Is FeuilRecap Then
'copié-collé
Wsh.Range("i1:v1").Cut FeuilRecap.Rows(k)
'ligne suivante pour le collage
k = k + 1
End If
Next Wsh
End Sub
A voir également:
- Programme VBA
- Programme demarrage windows - Guide
- Message programmé iphone - Guide
- Mettre en veille un programme - Guide
- Programme word gratuit - Guide
- Cette action ne peut pas être réalisée car le fichier est ouvert dans un autre programme - Guide
6 réponses
yg_be
Messages postés
23541
Date d'inscription
Statut
Contributeur
Dernière intervention
Ambassadeur
1 584
en bas de tableau ou a la première ligne de tableau?
c'est toi qui a écrit:
c'est toi qui a écrit:
k = 2 'autant débuter le "collage" à la seconde ligne?
oui , k=2 pour commencer le tableau
mais comment faire pour commencer chaque fois a la dernière ligne de tableau ! ou il va faire décaler les cellules vers le bas de tel manière a ne pas les écraser ; et mettre les nvelle donnes a la place!
mais comment faire pour commencer chaque fois a la dernière ligne de tableau ! ou il va faire décaler les cellules vers le bas de tel manière a ne pas les écraser ; et mettre les nvelle donnes a la place!
bonjour
k=wsh.UsedRange.Rows(wsh.UsedRange.Rows.Count).Row+1
il faut laisser le programme tel quel est rajouter cette ligne?
la mettre a la place de k=k+1?
comment?
merci
k=wsh.UsedRange.Rows(wsh.UsedRange.Rows.Count).Row+1
il faut laisser le programme tel quel est rajouter cette ligne?
la mettre a la place de k=k+1?
comment?
merci
j'ai fais ça! mais sa marche pas.
ACUALISER
' Dim Wsh As Worksheet, FeuilRecap As Worksheet, k As Integer
Set FeuilRecap = Worksheets("TABLEAU") 'feuille ou coller
k=wsh.UsedRange.Rows(wsh.UsedRange.Rows.Count).Row+1
'boucle sur toutes les feuilles du classeur
For Each Wsh In ThisWorkbook.Worksheets
'Si la feuille (en cours dans la boucle) n'est pas la feuille récap alors
If Not Wsh Is FeuilRecap Then
'copié-collé
Wsh.Range("i1:v1").Cut FeuilRecap.Rows(k)
'ligne suivante pour le collage
k = k + 1
End If
Next Wsh
End Sub
sa bloque....
ACUALISER
' Dim Wsh As Worksheet, FeuilRecap As Worksheet, k As Integer
Set FeuilRecap = Worksheets("TABLEAU") 'feuille ou coller
k=wsh.UsedRange.Rows(wsh.UsedRange.Rows.Count).Row+1
'boucle sur toutes les feuilles du classeur
For Each Wsh In ThisWorkbook.Worksheets
'Si la feuille (en cours dans la boucle) n'est pas la feuille récap alors
If Not Wsh Is FeuilRecap Then
'copié-collé
Wsh.Range("i1:v1").Cut FeuilRecap.Rows(k)
'ligne suivante pour le collage
k = k + 1
End If
Next Wsh
End Sub
sa bloque....
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
merci
SA MARCHE
mais il colle sur la dernière ligne! " il écrase la derniere ligne dejà rempli
je veux au dessous! just au dessous des données, je veux perdre a chaque fois une ligne!
SA MARCHE
mais il colle sur la dernière ligne! " il écrase la derniere ligne dejà rempli
je veux au dessous! just au dessous des données, je veux perdre a chaque fois une ligne!
merci bcp
sa marche
bravo
il me reste une macro pour supprimer les doublons et les ligne vides
j ai fais une pour les doublons ! (je l'ai trouvé sur ce forum)
mais pas pour les ligne vide!
voici la macro
------------------
Sub SupprimerDoublons4C()
Dim monDico As Object
Dim i As Integer
Set monDico = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
i = 1
Do While Cells(i, "A") <> ""
If Not monDico.Exists(Cells(i, "A") & Cells(i, "B") & Cells(i, "C") & Cells(i, "D")) Then
monDico(Cells(i, "A") & Cells(i, "B") & Cells(i, "C") & Cells(i, "D")) = ""
i = i + 1
Else
Rows(i).EntireRow.Delete
End If
Loop
End Sub
------------------------------
sa marche
bravo
il me reste une macro pour supprimer les doublons et les ligne vides
j ai fais une pour les doublons ! (je l'ai trouvé sur ce forum)
mais pas pour les ligne vide!
voici la macro
------------------
Sub SupprimerDoublons4C()
Dim monDico As Object
Dim i As Integer
Set monDico = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
i = 1
Do While Cells(i, "A") <> ""
If Not monDico.Exists(Cells(i, "A") & Cells(i, "B") & Cells(i, "C") & Cells(i, "D")) Then
monDico(Cells(i, "A") & Cells(i, "B") & Cells(i, "C") & Cells(i, "D")) = ""
i = i + 1
Else
Rows(i).EntireRow.Delete
End If
Loop
End Sub
------------------------------