Microsoft 365 Copier un tableau vers une autre feuille... VBA

[leoronaldo]

Bonjour,

je cherche à copier un tableau (en feuille A) vers un autre onglet (feuille B) ou il y aura un tableau déjà compléter.
le but et de rajouter a la suite les données du tableau 1 en feuille A vers le tableau 2 en feuille B.
mais il y a des modifications a faire pour arrivé au résultat du tableau B

il y a une colonne ID, il faut que les chiffres en collant le tableau correspondent 18 19 20 .....
il faut supprimer dans la colonne NOM tout les caractères avant le premier nom "05567 / "
et ne pas copier les lignes ou l'info et vide ou manquante.

Merci de votre aide.

Feuil A =

Feuil B =

 

[sousou]

Bonjour
Une solution.
Je n'ai pas supprimer les espaces entre nom prénom?

 

[Robert]

Bonjour le fil, bonjour le forum,

Une autre proposition avec le code ci-dessous :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim PS As Range 'déclare la variable PS (Plage Source)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim C As Integer 'déclare la variable C (Compteur)
Dim K As Integer 'déclare la variable K (incrément)
Dim I As Integer 'déclare la variable I (Incrément)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)

Set OS = Worksheets("FeuilA") 'définit l'onglet source OS
Set OD = Worksheets("FeuilB") 'définit l'onglet destination OD
Set PS = OS.Range("B3").CurrentRegion 'définit la plage source PS
Set PS = PS.Offset(1, 0).Resize(PS.Rows.Count - 1) 'redéfinit la plage source PS (sans la première ligne)
Set DEST = OD.Cells(Application.Rows.Count, "C").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
PS.Copy DEST 'copie la plage source PS dans la cellule de destination DEST
TV = OD.Range("C2").CurrentRegion 'définit le tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 4) <> "" Then 'condition 1 : si la donnée ligne I colonne 4 de TV n'est pas vide
        K = K + 1: C = C + 1 'incrémente le compteur C, incrémente la variable K
        ReDim Preserve TL(1 To 4, 1 To K) 'redimensionne les tableau des lignes TL (4 lignes, K colonnes)
        TL(1, K) = C 'définit la donnée ligne 1 colonne K de TL
        TL(2, K) = CDate(TV(I, 2)) 'récupère la donnée ligne I colonne 2 de TV dans la ligne 2 colonne K de TL (=> transposition)
        If UBound(Split(TV(I, 3), " / ")) > 0 Then 'condition 2 : si les caractères " / " existent
            TL(3, K) = Split(TV(I, 3), " / ")(1) 'récupère le texte àprès les caractères dans la ligne 3 colonne K de TL
        Else 'sinon
            TL(3, K) = TV(I, 3) 'récupère la donnée ligne I colonne 3 de TV dans la ligne 3 colonne K de TL (=> transposition)
        End If 'fin de la condition 2
        TL(4, K) = TV(I, 4) 'récupère la donnée ligne I colonne 4 de TV dans la ligne 4 colonne K de TL (=> transposition)
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
OD.Range("C2").CurrentRegion.Offset(1, 0).ClearContents 'efface les anciennes données
OD.Range("C3").Resize(K, 4).Value = Application.Transpose(TL) 'renvoie dans C3 redimensionnée le tableau TL transposé
OD.Columns(4).HorizontalAlignment = xlRight 'alligmenet des dates à droite
DL = OD.Cells(Application.Rows.Count, "C").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne C de l'onglet OD
OD.Rows(DL + 1 & ":" & Application.Rows.Count).Delete 'efface toutes les lignes après DL
OD.Activate 'active l'onglet OD
End Sub

Le Fichier :

 

[leoronaldo]

Bonsoir à tous,
Merci du retour,
c'est parfait un grand merci.

 

[leoronaldo]

@Robert

Une dernière précision si la feuille A et dans le classeur A mais la feuille B est dans le classeur B
comment puis je adapter la macro avec un Application.GetOpenFilename

Set OS = Workbooks("ClasseurA.xls").Sheets("FeuilleA")

Set OD = Application.GetOpenFilename [ (nom du fichier classeur B) sheets("feuilleB") ]

et si la feuille est cacher (visible= very hidden)
sheets("feuilleB").Visible = xlSheetVisible

bien sûr ensuite après copie dans la feuille B, save and close

je bloque pour celui là (Set OD)

d'ailleurs est il obligé d'ouvrir le fichier destination ou il peut le copier directement sans l'ouvrir ?
et aussi j'ai oublier avant de faire la manip vérifier si le fichier et en lecture seule ou pas, car si lecture seule annuler la macro.

 

[sousou]

Application.Getopenfilename renvoi le nom du fichier sélectionné et nom pas l'objet.
nOD =Application.GetOpenFilename ("Excel(*.xlsx),.*xlsx")
set OD= activeworkbook.

 

[leoronaldo]

Ok parfait merci

maintenant j'ai une autre question j'ai un soucis de date
lorsque je transfert d'un tableau a un autre avec un nouveau classeur (copier coller) les dates ne correspondent pas.

certaines sont OK, d'autres sont intervertie. au lieu de 05/10/21 j'ai 10/05/21
alors que le format de cellules est identique des 2 cotés. y ' a t'il une solution ? ou s'agit t'il d'un bug du pc ou d'excel 365 ?

merci