Le transfert ultime

Question

Je me permet de remettre ce sujet sur le haut du sac car plusieurs détails se sont rajoutés : "Je travail avec Excel et MS Project et comme je veux que ces deux logiciels communiquent il faut que l'un puisse lire l'autre sauf que le problème est que : MSP ne lit pas d'Excel avec macros, seulement en lecture seule et ce n'est pas ce qui m'intéresse. J'aimerais une macro qui puisse envoyer un certain nombres de données voulu dans un autre classeur quant à lui sans macros . je développe: J'aurais besoin d'une macro me permettant de transférer un tableau d'un document Excel comportant des macros à un autre document Excel quant à lui sans macros. Enfaîte ça revient à faire un copier coller dans un autre classeur mais j'aimerais une macro pour réaliser cette opération. Ou quelqu'un à une solution sur le problème que MS Project ne puisse pas lire Excel avec macro. Merci de vos futurs réponses bonnes ou mauvaise." Alors d'une part il y a le transfert de données mais d'autre part il faut aussi modifier l'arrivée des données: les colonnes changent. ordre de base: A/B/C/D/E/F/G/H/I ordre de fin dans le classeur d'arrivé: G/H/I/A/D/B/C/E/F Cordialement, Matthieu...

ThauThème · Accepted Answer

Re,

Bon Mattzif, je t'ai définitivement placé dans ma liste rouge. Celle que je nomme les TDC du Forum. Mais comme je n'aime pas laisser en plan ce que j'ai commencé, voici le code commenté. Il faut le placer dans le classeur source (fichier.text.xlsm) et il faut que les deux fichiers soient impérativement ouverts avant de lancer la macro ci-dessous :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim NC As Byte 'déclare la variable NC (Nombre de Colonne)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("final") 'définit l'onglet source OS
Set CD = Workbooks("fichier export.xlsx") 'définit le classeur destination CD
Set OD = CD.Worksheets("export") 'définit l'onglet destination OD
OD.Range("A1").CurrentRegion.ClearContents 'efface d'éventuelles anciennes données dans l'onglet OD
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
ici1: 'étiquette 1
LD = Application.InputBox("Quelle est la ligne de début", "DÉBUT", Type:=1) 'définit la boîte d'entrée LD pour la ligne de début
If LD = False Then Exit Sub 'si bouton [Annuler] sort de la procédure
If LD < 2 Or LD > NL Then 'condition : si LD est inférieure à 2 ou supérieure à NL
    MsgBox "Numéro de ligne invalide ! Recommencez." 'message
    GoTo ici1 'va à l'étiquette 1
End If 'fin de la condition
ici2: 'étiquette 2
LF = Application.InputBox("Quelle est la ligne de fin", "FIN", Type:=1) 'définit la boîte d'entrée LF pour la ligne de fin
If LF = False Then Exit Sub 'si bouton [Annuler] sort de la procédure
If LF < 2 Or LF > NL Then 'condition : si LF est inférieure à 2 ou supérieure à NL
    MsgBox "Numéro de ligne invalide ! Recommencez." 'message
    GoTo ici2 'va à l'étiquette 2
End If 'fin de la condition
If LD > LF Then 'condition : si la ligne de début est supérieure à la ligne de fin
    MsgBox "Le numéro de ligne de fin doit être supérieur au numéro de ligne du début ! Veuillez rééditer les deux valeurs." 'message
    GoTo ici1 'va à l'étiquette 1
End If 'fin de la condition
'copie de la première ligne dans le nouvel ordre
ReDim TL(1 To NC, 1 To 1) 'redimensionne le tableau des lignes (autant de ligne que TV a de colonnes, 1 colonne)
TL(1, 1) = TV(1, 7) 'renvoie dans la ligne 1 de TL l'étiquette en colonne 7 de TV
TL(2, 1) = TV(1, 8) 'renvoie dans la ligne 2 de TL l'étiquette en colonne 8 de TV
TL(3, 1) = TV(1, 9) 'renvoie dans la ligne 3 de TL l'étiquette en colonne 9 de TV
TL(4, 1) = TV(1, 1) 'renvoie dans la ligne 4 de TL l'étiquette en colonne 1 de TV
TL(5, 1) = TV(1, 4) 'renvoie dans la ligne 5 de TL l'étiquette en colonne 4 de TV
TL(6, 1) = TV(1, 2) 'renvoie dans la ligne 6 de TL l'étiquette en colonne 2 de TV
TL(7, 1) = TV(1, 3) 'renvoie dans la ligne 7 de TL l'étiquette en colonne 3 de TV
TL(8, 1) = TV(1, 5) 'renvoie dans la ligne 8 de TL l'étiquette en colonne 5 de TV
TL(9, 1) = TV(1, 6) 'renvoie dans la ligne 9 de TL l'étiquette en colonne 6 de TV
K = 2 'initialise la variable 2
For I = LD To LF 'boucle sur toutes les ligne I comprises entre la ligne de début LD et la ligne de fin LF
    ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL (autant de ligne que TV a de colonnes, K colonnes)
    TL(1, K) = TV(I, 7) 'renvoie dans la ligne 1 de TL la donnée en colonne 7 de TV
    TL(2, K) = TV(I, 8) 'renvoie dans la ligne 2 de TL la donnée en colonne 8 de TV
    TL(3, K) = TV(I, 9) 'renvoie dans la ligne 3 de TL la donnée en colonne 9 de TV
    TL(4, K) = TV(I, 1) 'renvoie dans la ligne 4 de TL la donnée en colonne 2 de TV
    TL(5, K) = TV(I, 4) 'renvoie dans la ligne 5 de TL la donnée en colonne 4 de TV
    TL(6, K) = IIf(TV(I, 2) = "", "", CLng(DateSerial(Year(TV(I, 2)), Month(TV(I, 2)), Day(TV(I, 2))))) 'renvoie dans la ligne 6 de TL la donnée en colonne 2 de TV (convertie en enrier de date)
    TL(7, K) = IIf(TV(I, 3) = "", "", CLng(DateSerial(Year(TV(I, 3)), Month(TV(I, 3)), Day(TV(I, 3))))) 'renvoie dans la ligne 7 de TL la donnée en colonne 3 de TV (convertie en enrier de date)
    TL(8, K) = TV(I, 5) 'renvoie dans la ligne 8 de TL la donnée en colonne 5 de TV
    TL(9, K) = TV(I, 6) 'renvoie dans la ligne 9 de TL la donnée en colonne 6 de TV
    K = K + 1 'incrémente K
Next I 'prochaine Ligne de la boucle
'si K est supérieure à 2, renvoie dans A1 redimensionnée de l'onglet OD le tableau TL transposé
If K > 2 Then OD.Range("A1").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
OS.Range("A1").CurrentRegion.Copy 'copie le tableau source
OD.Range("A1").CurrentRegion.PasteSpecial xlPasteColumnWidths 'colle la largeur des colonnes dans le tableau destination
OD.Range("A1").CurrentRegion.PasteSpecial xlPasteFormats 'colle les couleurs dans le tableau destination
OD.Columns(6).NumberFormat = "dd-mmm" 'définit le format des dates en colonne 6 du tableau destination
OD.Columns(7).NumberFormat = "dd-mmm" 'définit le format des dates en colonne 7 du tableau destination
CD.Activate 'active le classeur destination
OD.Select 'active l'onglet destination
OD.Range("A1").Select 'sélectionne la cellule A1
End Sub

MFerrand · Answer

Ton sujet est une réplique.

Tu as déjà eu des réponses de ThauThème (que j'ai trouvé particulièrement patient à ton égard ! ).

Tu sais donc parfaitement ce qu'il y a lieu de faire pour obtenir une réponse utile !

Tu le fais ! ou bien tu t'y refuses, et alors tu t'abstiens d'insister bêtement !

MFerrand · Answer

Il va être heureux de l'entendre ! Tu refuses de fournir un fichier, et parallèlement tu n'es pas foutu de fournir les précisions indispensables pour écrire un code (références de feuilles, de plages, etc.) Ne t'attends pas à être bien reçu en ayant une attitude que je qualifierais volontiers d'aussi insultante à l'égard d'intervenants disposés à t'assister.....

ThauThème · Answer

Tiens, il n'est pas que pénible, il est aussi comique le Mattzif !... Écoute, que tu ne puisses fournir un fichier confidentiel, je le conçois aisément. Mais que tu aies la flemme d'en créer un avec la même structure et des données bidons c'est ton problème. Comme je ne suis attaché à aucun site, plutôt à certaines valeurs, et que j'ai deux profils, le droit et le gauche (les deux tout aussi moches d'ailleurs), je crois que je vais rester. Ça te dérange pas, hein ?!.....

MFerrand · Answer

C'est plutôt toi qui n'a pas le profil de demandeur !

Il est toujours possible de fournir un fichier !

Cela se fabrique !

Cela demande juste un peu de travail pour établir un document conforme à l'original dans sa structure et dans le type des données.

C'est une contrepartie bien naturelle au travail que fournira l'intervenant...

Et ledit document permet en outre de fournir une réponse adaptée et testée.

La plupart des demandeurs sont en mesure de le comprendre.

Mais ce n'est certes pas le cas de ceux qui se permettent...

Si vous êtes sur ce forum sans avoir de patience détachez vous de ce site vous avez pas le profil pour.

... et qui pensent pouvoir venir sur un forum en tant que clients ayant droit (gratuitement) à des services.

On ne fournit pas de services sur un forum mais une entraide et une assistance dans un cadre de discussion collaborative.

Tu t'es trompé d'adresse quelque part !

MFerrand · Answer

Parce que depuis le 4 mai 2017, tu es en mesure d'apprécier ...

MFerrand · Answer

ThauThème a parfaitement raison, je vois ...

ThauThème · Answer

Re, Non ! Pas chef... Grand Chef, síl te plaît.....

ThauThème · Answer

Re, Si tu relis l'historique tu noteras que je t'avais demandé ce chemin ! En l'absence de réponse j'ai fait au mieux.....