Programme VBA
jacksa3ada
Messages postés
37
Statut
Membre
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention -
yg_be Messages postés 23437 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
6 réponses
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 588
en bas de tableau ou a la première ligne de tableau?
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! -
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 -
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.... -
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!-
-
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
------------------------------ -
-
-
-
