Cumul des lignes

Bonjour,

J'ai plusieurs fichiers un Maître (Gestion) et les autres des esclaves (Demande) , alors je souhaite faire un cumul des fichiers esclaves dans le fichier Maître .

j'ai mis le code ci dessous mais ça bug à Range("derlignee").Select , et quand j’enlève derlignee = Sheets("tableau").Range("A65536").End(xlUp).Row + 1 et Range("derlignee").Select ça fonctionne mais il ne fait pas le cumul , il copie des lignes sur les autres ! quelqu'un peut m'aider !

Merci

derlignee = Sheets("tableau").Range("A65536").End(xlUp).Row + 1
Windows("demande.xls").Activate
Sheets("2. Servers").Select
Range("B6:V20").Select
Selection.Copy
Windows("gestion.xls").Activate
Sheets("Tableau").Select
Range("J6").Select
Range("derlignee").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Bonjour,

remplace

Range("derlignee").Select 

par

Range("A" & derlignee).Select

Merci exelent ça marche , sinon il me reste un souci si tu as remarqué consérent les fichier esclave (à chaque fois le nom de fichier se change ) , il n'a pas moyen de donner au Macro avant l’exécution le nom de fichier esclave en tant que paramètre , il est representer dasn le code comme fixe

Windows("demande.xls").Activate

sinon pour le contenu est identique (les feuilles ...ect ) le seul souci et le nom de fichier !

déjà je prends des paramètres que j'ajoute sur le tableau , mais comment les utilisés dans le même Macro je sais pas merci pour votre aide .

Sub traitement()

Sheets("tableau").Activate
derligne = Sheets("tableau").Range("A65536").End(xlUp).Row + 1
Cells(derligne, 1) = Range("dt").Value
Cells(derligne, 2) = Range("demandeur").Value
Cells(derligne, 6) = Range("adresse").Value
Cells(derligne, 8) = Range("Flux").Value
Cells(derligne, 9) = Range("Statut").Value

 Range("demandeur").Value = ""
 Range("adresse").Value = ""
 Range("Flux").Value = ""
 Range("Statut").Value = ""

 'Partie les lignes serveurs

derlignee = Sheets("tableau").Range("A65536").End(xlUp).Row + 1
Windows("demande.xls").Activate
Sheets("2. Servers").Select
Range("B6:V20").Select
Selection.Copy
Windows("gestion.xls").Activate
Sheets("Tableau").Select
Range("A" & derlignee).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

' Fin Partie des lignes serveurs

End Sub

bonjour,

une proposition de macro pour la consolidation des tous les classeurs ouverts,à tester

Sub traitement()
' wst = feuille tableau du classeur gestion
Set wst = Workbooks("gestion.xls").Worksheets(Tableau)
derligne = wst.Range("A65536").End(xlUp).Row + 1
wst.Cells(derligne, 1) = wst.Range("dt").Value
wst.Cells(derligne, 2) = wst.Range("demandeur").Value
wst.Cells(derligne, 6) = wst.Range("adresse").Value
wst.Cells(derligne, 8) = wst.Range("Flux").Value
wst.Cells(derligne, 9) = wst.Range("Statut").Value

 wst.Range("demandeur").Value = ""
 wst.Range("adresse").Value = ""
 wst.Range("Flux").Value = ""
 wst.Range("Statut").Value = ""

 'Partie les lignes serveurs
For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
If UCase(wb.Name) <> UCase("gestion.xls") Then
derlignee = wst.Range("A65536").End(xlUp).Row + 1

wb.Sheets("2. Servers").Range("B6:V20").Copy wst.Range("A" & derlignee)
End If
Next
' Fin Partie des lignes serveurs

End Sub

j'ai compris le code c bien , mais je ne sais pas à l’exécution ça bug dans la première ligne !!

Set wst = Workbooks("gestion.xls").Worksheets(Tableau)

il manque un "Tableau"

mais encore ça bloque ici

wst.Cells(derligne, 1) = wst.Range("dt").Value

coolmomodu31 a écrit :

j'ai compris le code c bien , mais je ne sais pas à l’exécution ça bug dans la première ligne !!

Set wst = Workbooks("gestion.xls").Worksheets(Tableau)

mais encore ça bloque ici

wst.Cells(derligne, 1) = wst.Range("dt").Value

j'ai oublié les guillemets dans l'instruction set

Set wst = Workbooks("gestion.xls").Worksheets("Tableau")

oui j'ai vu ça , je l'ai mentionné et corrigé mais après ça bloque dans la ligne

wst.Cells(derligne, 1) = wst.Range("dt").Value

bonsoir,

le nom dt existe-t-il bien ?

le plus simple serait peut-être de joindre un exemple de gestion.xls et un exemple de demande.xls

oui biensur je l'ai vérifié en effet les noms :

"dt""demandeur""adresse""Flux""Statut"

Existe dasn la feuille "Demande De Travaux" dasn le fichier Gestion ! je pense q'il ne sont pas reconnu

en effet le resultat normalement est sur Tableau :

Le Macro apporte des infos de la feuille "demande de travaux" du fichier Maitre (une seule ligne composé avec des valeurs "cellules" (formulaire)) + les lignes du fichier esclave .

je pense que tout est claire maintenant , désolé j'étais pas assez claire avant , Merci Bcp

Sub traitement()
' wst = feuille tableau du classeur gestion
Set wst = Workbooks("gestion.xls").Worksheets("Tableau")
set wsd=workbooks("gestion.xls").worksheets("demande de travaux")
derligne = wst.Range("A65536").End(xlUp).Row + 1
wst.Cells(derligne, 1) = wsd.Range("dt").Value
wst.Cells(derligne, 2) = wsd.Range("demandeur").Value
wst.Cells(derligne, 6) = wstdRange("adresse").Value
wst.Cells(derligne, 8) = wsd.Range("Flux").Value
wst.Cells(derligne, 9) = wsd.Range("Statut").Value

 wsd.Range("demandeur").Value = ""
 wsd.Range("adresse").Value = ""
 wsd..Range("Flux").Value = ""
 wsd.Range("Statut").Value = ""

 'Partie les lignes serveurs
For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
If UCase(wb.Name) <> UCase("gestion.xls") Then
derlignee = wst.Range("A65536").End(xlUp).Row + 1

wb.Sheets("2. Servers").Range("B6:V20").Copy wst.Range("A" & derlignee)
End If
Next
' Fin Partie des lignes serveurs

End Sub

Merci BCP ça fonctionne à merveille . je viens également de reuissir à faire ça :

Sub traitement()
' wst = feuille tableau du classeur gestion
Set wst = Workbooks("gestion.xls").Worksheets("Tableau")
derligne = wst.Range("A65536").End(xlUp).Row + 1
Sheets("tableau").Activate
Cells(derligne, 1) = Range("dt").Value
Cells(derligne, 2) = Range("demandeur").Value
Cells(derligne, 3) = Range("adresse").Value
Cells(derligne, 4) = Range("Statut").Value

 Range("demandeur").Value = ""
 Range("adresse").Value = ""
 Range("Statut").Value = ""

 'Partie les lignes serveurs
For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
If UCase(wb.Name) <> UCase("gestion.xls") Then
derlignee = wst.Range("A65536").End(xlUp).Row + 1
wb.Sheets("2. Servers").Range("B6:V40").Copy wst.Range("A" & derlignee)
End If
Next
' Fin Partie des lignes serveurs

End Sub

Biensur grâce à ton Aide Merci BCP , Problème résolu ^^

Merci Bcp pour ton aide ton code fonctionne très bien ^^ moi également grâce à ton aide je viens de trouver ça ^^ chapeau mon ami ^^ Meerci encoore une fois

Sub traitement()
' wst = feuille tableau du classeur gestion
Set wst = Workbooks("gestion.xls").Worksheets("Tableau")
derligne = wst.Range("A65536").End(xlUp).Row + 1
Sheets("tableau").Activate
Cells(derligne, 1) = Range("dt").Value
Cells(derligne, 2) = Range("demandeur").Value
Cells(derligne, 3) = Range("adresse").Value
Cells(derligne, 4) = Range("Statut").Value

 Range("demandeur").Value = ""
 Range("adresse").Value = ""
 Range("Statut").Value = ""

 'Partie les lignes serveurs
For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
If UCase(wb.Name) <> UCase("gestion.xls") Then
derlignee = wst.Range("A65536").End(xlUp).Row + 1
wb.Sheets("2. Servers").Range("B6:V40").Copy wst.Range("A" & derlignee)
End If
Next
' Fin Partie des lignes serveurs

End Sub

Bonjour,

re , le problème s'est résolu avec succès mais avec la pratique quand je travaillais avec le fichier aujourd’hui j'ai remarqué que à la fin de l’exécution du Macro il faut que je reviens sur le tableau pour supprimer quelque lignes (les lignes ou leurs cellules sur la colonne A sont vide ) .

je pense qu'il faut ajouter une condition ici :

wb.Sheets("2. Servers").Range("B6:V40").Copy wst.Range("A" & derlignee)

avant de copier il doit vérifier si les cellules de la colonne A de la feuille "2. Servers" sont vide ou non , et copie que les ligne ou leurs cellules sur la colonne A sont non vide .

Merci pour votre aide .

bonsoir,

proposition de code. hypothèse, toutes les demandes dans une feuille se suivent (sans ligne vide entre 2 demandes), les lignes vides se trouvent à la fin.

Sub traitement()
' wst = feuille tableau du classeur gestion
Set wst = Workbooks("gestion.xls").Worksheets("Tableau")
set wbd=workbooks("gestion.xls")
derligne = wst.Range("A65536").End(xlUp).Row + 1
wst.Cells(derligne, 1) = wbd.Range("dt").Value
wst.Cells(derligne, 2) = wbd.Range("demandeur").Value
wst.Cells(derligne, 6) = wbd.Range("adresse").Value
wst.Cells(derligne, 8) = wbd.Range("Flux").Value
wst.Cells(derligne, 9) = wbd.Range("Statut").Value

 wbd.Range("demandeur").Value = ""
 wbd.Range("adresse").Value = ""
 wbd..Range("Flux").Value = ""
 wbd.Range("Statut").Value = ""

 'Partie les lignes serveurs
For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
If UCase(wb.Name) <> UCase("gestion.xls") Then
derlignee = wst.Range("A65536").End(xlUp).Row + 1
derlignes=wb.sheets(2. servers).range("B20").end(xlup).row
wb.Sheets("2. Servers").Range("B6:V" & derlignes).Copy wst.Range("A" & derlignee)
End If
Next
' Fin Partie des lignes serveurs

End Sub

Bonsoir,

Pour mieux comprendre ci joint une capture d’écran du fichier esclave , feuille "2 . servers" : alors dans ce cas normalement je dois copier dans le fichier gestion , feuille "tableau" que les lignes 20 et 21 ou la cellule de la colonne A et non vide.

Bonsoir,

à tester

Sub traitement()
' wst = feuille tableau du classeur gestion
Set wst = Workbooks("gestion.xls").Worksheets("Tableau")
set wbd=workbooks("gestion.xls")
derligne = wst.Range("A65536").End(xlUp).Row + 1
wst.Cells(derligne, 1) = wbd.Range("dt").Value
wst.Cells(derligne, 2) = wbd.Range("demandeur").Value
wst.Cells(derligne, 6) = wbd.Range("adresse").Value
wst.Cells(derligne, 8) = wbd.Range("Flux").Value
wst.Cells(derligne, 9) = wbd.Range("Statut").Value

 wbd.Range("demandeur").Value = ""
 wbd.Range("adresse").Value = ""
 wbd..Range("Flux").Value = ""
 wbd.Range("Statut").Value = ""

 'Partie les lignes serveurs
For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
If UCase(wb.Name) <> UCase("gestion.xls") Then
derlignee = wst.Range("A65536").End(xlUp).Row + 1

derlignes=wb.sheets("2. servers").range("A" & rows.count).end(xlup).row
'on recherche la première ligne contenant "new"
set re=wb.sheets("2.servers").range("A6:A" & derlignes).find("new",lookat:=xlpart)
if not re is nothing then
wb.Sheets("2. Servers").Range("B" & re.row & ":V" & derlignes).Copy wst.Range("A" & derlignee)
End If
Next
' Fin Partie des lignes serveurs

End Sub

Bonjour ,

Merci pour le code sinon il y avait des petit truc à modifier End IF , Not que tu as oublié , voici le code :

Sub t()
' wst = feuille tableau du classeur gestion
Set wst = Workbooks("gestion.xls").Worksheets("Tableau")
Set wbd = Workbooks("gestion.xls")
derligne = wst.Range("A65536").End(xlUp).Row + 1
Sheets("tableau").Activate
Cells(derligne, 1) = Range("dt").Value
Cells(derligne, 2) = Range("demandeur").Value
Cells(derligne, 3) = Range("adresse").Value
Cells(derligne, 4) = Range("Statut").Value
Cells(derligne, 5) = Range("CDS").Value

 Range("demandeur").Value = ""
 Range("adresse").Value = ""
 Range("Statut").Value = ""
 Range("CDS").Value = ""

 'Partie les lignes serveurs
For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
If UCase(wb.Name) <> UCase("gestion.xls") Then
derlignee = wst.Range("A65536").End(xlUp).Row + 1

derlignes = wb.Sheets("2. Servers").Range("A" & Rows.Count).End(xlUp).Row
'on recherche la première ligne contenant "new"
Set re = wb.Sheets("2. Servers").Range("A6:A" & derlignes).Find("new", lookat:=xlPart)
End If
If Not re Then
wb.Sheets("2. Servers").Range("B" & re.Row & ":V" & derlignes).Copy wst.Range("A" & derlignee)
End If
Next
' Fin Partie des lignes serveurs

End Sub

mais quand même à la fin ça bug dans cette ligne :

wb.Sheets("2. Servers").Range("B" & re.Row & ":V" & derlignes).Copy wst.Range("A" & derlignee)

!!

bonjour,

end if qui manquait à placer ailleurs, essaie ainsi

Sub t()
' wst = feuille tableau du classeur gestion
Set wst = Workbooks("gestion.xls").Worksheets("Tableau")
Set wbd = Workbooks("gestion.xls")
derligne = wst.Range("A65536").End(xlUp).Row + 1
Sheets("tableau").Activate
Cells(derligne, 1) = Range("dt").Value
Cells(derligne, 2) = Range("demandeur").Value
Cells(derligne, 3) = Range("adresse").Value
Cells(derligne, 4) = Range("Statut").Value
Cells(derligne, 5) = Range("CDS").Value

 Range("demandeur").Value = ""
 Range("adresse").Value = ""
 Range("Statut").Value = ""
 Range("CDS").Value = ""

 'Partie les lignes serveurs
For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
If UCase(wb.Name) <> UCase("gestion.xls") Then
derlignee = wst.Range("A65536").End(xlUp).Row + 1

derlignes = wb.Sheets("2. Servers").Range("A" & Rows.Count).End(xlUp).Row
'on recherche la première ligne contenant "new"
Set re = wb.Sheets("2. Servers").Range("A6:A" & derlignes).Find("new", lookat:=xlPart)

If Not re Then
wb.Sheets("2. Servers").Range("B" & re.Row & ":V" & derlignes).Copy wst.Range("A" & derlignee)
End If
End If
Next
' Fin Partie des lignes serveurs

End Sub
 

Oui Exactement ^^ bon travail man , tu ma bcp aider et j'ai bcp appris . Merci Bcp et bonne continuation "Chapeau"

Code final :

Sub NEW_Servers_Lines()
' wst = feuille tableau du classeur gestion
Set wst = Workbooks("gestion.xls").Worksheets("Tableau")
Set wbd = Workbooks("gestion.xls")
derligne = wst.Range("A65536").End(xlUp).Row + 1
Sheets("tableau").Activate
Cells(derligne, 1) = Range("dt").Value
Cells(derligne, 2) = Range("demandeur").Value
Cells(derligne, 3) = Range("adresse").Value
Cells(derligne, 4) = Range("Statut").Value
Cells(derligne, 5) = Range("CDS").Value

 Range("demandeur").Value = ""
 Range("adresse").Value = ""
 Range("Statut").Value = ""
 Range("CDS").Value = ""

 'Partie les lignes serveurs
For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
If UCase(wb.Name) <> UCase("gestion.xls") Then
derlignee = wst.Range("A65536").End(xlUp).Row + 1

derlignes = wb.Sheets("2. Servers").Range("A" & Rows.Count).End(xlUp).Row
'on recherche la première ligne contenant "new"
Set re = wb.Sheets("2. Servers").Range("A6:A" & derlignes).Find("new", lookat:=xlPart)
If Not re Is Nothing Then
wb.Sheets("2. Servers").Range("B" & re.Row & ":V" & derlignes).Copy wst.Range("A" & derlignee)
End If
End If
Next
' Fin Partie des lignes serveurs

End Sub