Macro et sélection dernière colonne

MichD

02/11/2020 à 16:21

Le 02/11/20 Í 08:38, Yannick Son Vidéo a écritÂ :

hello Í tous,
j'aurais besoin d'un petit coup de main, j'ai une macro que je fais créer manuellement.
la macro récupère les infos d'une colonne (dans plusieurs feuille) pour les mettre dans un tableau.
Je voudrais que la macro récupère Í la place les infos de la "dernière" colonne (de chaque feuille) pour le mettre dans un tableau 1 dans une nouvelle feuille (feuille résumé)
et reprendre aussi les infos de l'avant dernière colonne (de chaque feuille) pour le mettre dans un tableau 2 dans la feuille résumé qui serait donc sous le tableau 1.
enfin je voudrais ajouter un déclencheur pour le faire chaque mois.
Afin de faire un comparatif mois par mois.
Est ce qu'il existe déjÍ une macro qui fait ça ? ou je dois vous montrer la macro que j'ai enregistré ?
merci de votre aide, en espérant que c'est assez clair.

Bonjour,
J'ai supposé que tu as une feuille dont le nom de l'onglet est
"Résultat". Cette feuille contient déjÍ les 2 tableaux (table)
Tableau1 doit recevoir la dernière colonne de chacune des feuilles
Tableau2 doit recevoir l'avant-dernière colonne des chacune des feuilles
Si le nom de la feuille "Résultat" est différent de même que le nom des
tableaux, tu devras adapter dans le code.
'--------------------------------------------------
Sub test()
Dim Sh As Worksheet, X As Variant
Dim DerCol As Long, DerLig As Long
Dim Tbl As ListObject, Col As Long
Dim Tbl2 As ListObject, Col2 As Long, Y As Variant
'Variable Tbl pointant vers le tableau1
Set Tbl = Worksheets("Résultat").ListObjects("Tableau1")
Set Tbl2 = Worksheets("Résultat").ListObjects("Tableau2")
'Boucle sur chacune des feuilles
For Each Sh In Worksheets
'Avec chacune des feuilles
With Sh
'Si son nom d'onglet est différent de "Résultat"
If Name <> "Résultat" Then
'Trouve la dernière colonne occupée dans la feuille
DerCol = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'Trouve la dernière ligne de la dernière colonne
DerLig = .Columns(DerCol).Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
With Worksheets("Résultat")
'Col = la colonne que l'on va ajoutée
Col = Tbl.Range.Columns.Count + 1
Col2 = Tbl2.Range.Columns.Count + 1
'Ajoute une colonne Í la droite du tableau1
Tbl.ListColumns.Add(Col).Name = "Temp"
'Ajoute une colonne Í la droite du tableau12
Tbl2.ListColumns.Add(Col2).Name = "Temp"
'Places les données Í copier dans une variable (Array)
X = Sh.Range(Sh.Cells(1, DerCol), Sh.Cells(DerLig, DerCol))
Y = Sh.Range(Sh.Cells(1, 1), Sh.Cells(DerLig, DerCol - 1))
'Dans la colonne ajoutée au tableau1
With Tbl.Range(1, Col)
'copie des données
.Resize(UBound(X, 1), UBound(X, 2)).Value = X
End With
'Dans la colonne ajoutée au tableau2
With Tbl2.Range(1, Col2)
'copie des données
.Resize(UBound(Y, 1), UBound(Y, 2)).Value = Y
End With
'Attribue Í la colonne ajoutée le nom l'en-tête
'de la colonne copiée.
Tbl.ListColumns(Col).Name = Sh.Cells(1, DerCol)
Tbl2.ListColumns(Col2).Name = Sh.Cells(1, DerCol - 1)
End With
End If
End With
Next
End Sub
'--------------------------------------------------
MichD

Le 02/11/20 Í 08:38, Yannick Son Vidéo a écritÂ :

hello Í tous,

j'aurais besoin d'un petit coup de main, j'ai une macro que je fais créer manuellement.
la macro récupère les infos d'une colonne (dans plusieurs feuille) pour les mettre dans un tableau.

Je voudrais que la macro récupère Í la place les infos de la "dernière" colonne (de chaque feuille) pour le mettre dans un tableau 1 dans une nouvelle feuille (feuille résumé)
et reprendre aussi les infos de l'avant dernière colonne (de chaque feuille) pour le mettre dans un tableau 2 dans la feuille résumé qui serait donc sous le tableau 1.

enfin je voudrais ajouter un déclencheur pour le faire chaque mois.

Afin de faire un comparatif mois par mois.

Est ce qu'il existe déjÍ une macro qui fait ça ? ou je dois vous montrer la macro que j'ai enregistré ?

merci de votre aide, en espérant que c'est assez clair.

Bonjour,

J'ai supposé que tu as une feuille dont le nom de l'onglet est
"Résultat". Cette feuille contient déjÍ les 2 tableaux (table)
Tableau1 doit recevoir la dernière colonne de chacune des feuilles
Tableau2 doit recevoir l'avant-dernière colonne des chacune des feuilles

Si le nom de la feuille "Résultat" est différent de même que le nom des
tableaux, tu devras adapter dans le code.

'--------------------------------------------------
Sub test()
Dim Sh As Worksheet, X As Variant
Dim DerCol As Long, DerLig As Long
Dim Tbl As ListObject, Col As Long
Dim Tbl2 As ListObject, Col2 As Long, Y As Variant

'Variable Tbl pointant vers le tableau1
Set Tbl = Worksheets("Résultat").ListObjects("Tableau1")
Set Tbl2 = Worksheets("Résultat").ListObjects("Tableau2")

'Boucle sur chacune des feuilles
For Each Sh In Worksheets
'Avec chacune des feuilles
With Sh
'Si son nom d'onglet est différent de "Résultat"
If Name <> "Résultat" Then
'Trouve la dernière colonne occupée dans la feuille
DerCol = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'Trouve la dernière ligne de la dernière colonne
DerLig = .Columns(DerCol).Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

With Worksheets("Résultat")
'Col = la colonne que l'on va ajoutée
Col = Tbl.Range.Columns.Count + 1
Col2 = Tbl2.Range.Columns.Count + 1
'Ajoute une colonne Í la droite du tableau1
Tbl.ListColumns.Add(Col).Name = "Temp"
'Ajoute une colonne Í la droite du tableau12
Tbl2.ListColumns.Add(Col2).Name = "Temp"
'Places les données Í copier dans une variable (Array)

X = Sh.Range(Sh.Cells(1, DerCol), Sh.Cells(DerLig, DerCol))

Y = Sh.Range(Sh.Cells(1, 1), Sh.Cells(DerLig, DerCol - 1))

'Dans la colonne ajoutée au tableau1
With Tbl.Range(1, Col)
'copie des données
.Resize(UBound(X, 1), UBound(X, 2)).Value = X
End With
'Dans la colonne ajoutée au tableau2
With Tbl2.Range(1, Col2)
'copie des données
.Resize(UBound(Y, 1), UBound(Y, 2)).Value = Y
End With

'Attribue Í la colonne ajoutée le nom l'en-tête
'de la colonne copiée.
Tbl.ListColumns(Col).Name = Sh.Cells(1, DerCol)
Tbl2.ListColumns(Col2).Name = Sh.Cells(1, DerCol - 1)
End With
End If
End With
Next
End Sub
'--------------------------------------------------

MichD

Vous avez filtré cet utilisateur ! Consultez son message

Le 02/11/20 Í 08:38, Yannick Son Vidéo a écritÂ :

hello Í tous,
j'aurais besoin d'un petit coup de main, j'ai une macro que je fais créer manuellement.
la macro récupère les infos d'une colonne (dans plusieurs feuille) pour les mettre dans un tableau.
Je voudrais que la macro récupère Í la place les infos de la "dernière" colonne (de chaque feuille) pour le mettre dans un tableau 1 dans une nouvelle feuille (feuille résumé)
et reprendre aussi les infos de l'avant dernière colonne (de chaque feuille) pour le mettre dans un tableau 2 dans la feuille résumé qui serait donc sous le tableau 1.
enfin je voudrais ajouter un déclencheur pour le faire chaque mois.
Afin de faire un comparatif mois par mois.
Est ce qu'il existe déjÍ une macro qui fait ça ? ou je dois vous montrer la macro que j'ai enregistré ?
merci de votre aide, en espérant que c'est assez clair.

Bonjour,
J'ai supposé que tu as une feuille dont le nom de l'onglet est
"Résultat". Cette feuille contient déjÍ les 2 tableaux (table)
Tableau1 doit recevoir la dernière colonne de chacune des feuilles
Tableau2 doit recevoir l'avant-dernière colonne des chacune des feuilles
Si le nom de la feuille "Résultat" est différent de même que le nom des
tableaux, tu devras adapter dans le code.
'--------------------------------------------------
Sub test()
Dim Sh As Worksheet, X As Variant
Dim DerCol As Long, DerLig As Long
Dim Tbl As ListObject, Col As Long
Dim Tbl2 As ListObject, Col2 As Long, Y As Variant
'Variable Tbl pointant vers le tableau1
Set Tbl = Worksheets("Résultat").ListObjects("Tableau1")
Set Tbl2 = Worksheets("Résultat").ListObjects("Tableau2")
'Boucle sur chacune des feuilles
For Each Sh In Worksheets
'Avec chacune des feuilles
With Sh
'Si son nom d'onglet est différent de "Résultat"
If Name <> "Résultat" Then
'Trouve la dernière colonne occupée dans la feuille
DerCol = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'Trouve la dernière ligne de la dernière colonne
DerLig = .Columns(DerCol).Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
With Worksheets("Résultat")
'Col = la colonne que l'on va ajoutée
Col = Tbl.Range.Columns.Count + 1
Col2 = Tbl2.Range.Columns.Count + 1
'Ajoute une colonne Í la droite du tableau1
Tbl.ListColumns.Add(Col).Name = "Temp"
'Ajoute une colonne Í la droite du tableau12
Tbl2.ListColumns.Add(Col2).Name = "Temp"
'Places les données Í copier dans une variable (Array)
X = Sh.Range(Sh.Cells(1, DerCol), Sh.Cells(DerLig, DerCol))
Y = Sh.Range(Sh.Cells(1, 1), Sh.Cells(DerLig, DerCol - 1))
'Dans la colonne ajoutée au tableau1
With Tbl.Range(1, Col)
'copie des données
.Resize(UBound(X, 1), UBound(X, 2)).Value = X
End With
'Dans la colonne ajoutée au tableau2
With Tbl2.Range(1, Col2)
'copie des données
.Resize(UBound(Y, 1), UBound(Y, 2)).Value = Y
End With
'Attribue Í la colonne ajoutée le nom l'en-tête
'de la colonne copiée.
Tbl.ListColumns(Col).Name = Sh.Cells(1, DerCol)
Tbl2.ListColumns(Col2).Name = Sh.Cells(1, DerCol - 1)
End With
End If
End With
Next
End Sub
'--------------------------------------------------
MichD

MichD

02/11/2020 à 16:25

C'est la même procédure, mais avec ceci en plus afin d'améliorer la
vitesse du traitement.
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'-----------------------------------------------
Sub test()
Dim Sh As Worksheet, X As Variant
Dim DerCol As Long, DerLig As Long
Dim Tbl As ListObject, Col As Long
Dim Tbl2 As ListObject, Col2 As Long, Y As Variant
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Variable Tbl pointant vers le tableau1
Set Tbl = Worksheets("Résultat").ListObjects("Tableau1")
Set Tbl2 = Worksheets("Résultat").ListObjects("Tableau2")
'Boucle sur chacune des feuilles
For Each Sh In Worksheets
'Avec chacune des feuilles
With Sh
'Si son nom d'onglet est différent de "Résultat"
If Name <> "Résultat" Then
'Trouve la dernière colonne occupée dans la feuille
DerCol = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'Trouve la dernière ligne de la dernière colonne
DerLig = .Columns(DerCol).Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
With Worksheets("Résultat")
'Col = la colonne que l'on va ajoutée
Col = Tbl.Range.Columns.Count + 1
Col2 = Tbl2.Range.Columns.Count + 1
'Ajoute une colonne Í la droite du tableau1
Tbl.ListColumns.Add(Col).Name = "Temp"
'Ajoute une colonne Í la droite du tableau12
Tbl2.ListColumns.Add(Col2).Name = "Temp"
'Places les données Í copier dans une variable (Array)
X = Sh.Range(Sh.Cells(1, DerCol), Sh.Cells(DerLig, DerCol))
Y = Sh.Range(Sh.Cells(1, 1), Sh.Cells(DerLig, DerCol - 1))
'Dans la colonne ajoutée au tableau1
With Tbl.Range(1, Col)
'copie des données
.Resize(UBound(X, 1), UBound(X, 2)).Value = X
End With
'Dans la colonne ajoutée au tableau2
With Tbl2.Range(1, Col2)
'copie des données
.Resize(UBound(Y, 1), UBound(Y, 2)).Value = Y
End With
'Attribue Í la colonne ajoutée le nom l'en-tête
'de la colonne copiée.
Tbl.ListColumns(Col).Name = Sh.Cells(1, DerCol)
Tbl2.ListColumns(Col2).Name = Sh.Cells(1, DerCol - 1)
End With
End If
End With
Next
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
'-----------------------------------------------
MichD

C'est la même procédure, mais avec ceci en plus afin d'améliorer la
vitesse du traitement.

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

'-----------------------------------------------
Sub test()
Dim Sh As Worksheet, X As Variant
Dim DerCol As Long, DerLig As Long
Dim Tbl As ListObject, Col As Long
Dim Tbl2 As ListObject, Col2 As Long, Y As Variant

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

'Variable Tbl pointant vers le tableau1
Set Tbl = Worksheets("Résultat").ListObjects("Tableau1")
Set Tbl2 = Worksheets("Résultat").ListObjects("Tableau2")

'Boucle sur chacune des feuilles
For Each Sh In Worksheets
'Avec chacune des feuilles
With Sh
'Si son nom d'onglet est différent de "Résultat"
If Name <> "Résultat" Then
'Trouve la dernière colonne occupée dans la feuille
DerCol = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'Trouve la dernière ligne de la dernière colonne
DerLig = .Columns(DerCol).Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

With Worksheets("Résultat")
'Col = la colonne que l'on va ajoutée
Col = Tbl.Range.Columns.Count + 1
Col2 = Tbl2.Range.Columns.Count + 1
'Ajoute une colonne Í la droite du tableau1
Tbl.ListColumns.Add(Col).Name = "Temp"
'Ajoute une colonne Í la droite du tableau12
Tbl2.ListColumns.Add(Col2).Name = "Temp"
'Places les données Í copier dans une variable (Array)
X = Sh.Range(Sh.Cells(1, DerCol), Sh.Cells(DerLig, DerCol))
Y = Sh.Range(Sh.Cells(1, 1), Sh.Cells(DerLig, DerCol - 1))

'Dans la colonne ajoutée au tableau1
With Tbl.Range(1, Col)
'copie des données
.Resize(UBound(X, 1), UBound(X, 2)).Value = X
End With
'Dans la colonne ajoutée au tableau2
With Tbl2.Range(1, Col2)
'copie des données
.Resize(UBound(Y, 1), UBound(Y, 2)).Value = Y
End With

'Attribue Í la colonne ajoutée le nom l'en-tête
'de la colonne copiée.
Tbl.ListColumns(Col).Name = Sh.Cells(1, DerCol)
Tbl2.ListColumns(Col2).Name = Sh.Cells(1, DerCol - 1)
End With
End If
End With
Next
With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub
'-----------------------------------------------

MichD

Vous avez filtré cet utilisateur ! Consultez son message

C'est la même procédure, mais avec ceci en plus afin d'améliorer la
vitesse du traitement.
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'-----------------------------------------------
Sub test()
Dim Sh As Worksheet, X As Variant
Dim DerCol As Long, DerLig As Long
Dim Tbl As ListObject, Col As Long
Dim Tbl2 As ListObject, Col2 As Long, Y As Variant
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Variable Tbl pointant vers le tableau1
Set Tbl = Worksheets("Résultat").ListObjects("Tableau1")
Set Tbl2 = Worksheets("Résultat").ListObjects("Tableau2")
'Boucle sur chacune des feuilles
For Each Sh In Worksheets
'Avec chacune des feuilles
With Sh
'Si son nom d'onglet est différent de "Résultat"
If Name <> "Résultat" Then
'Trouve la dernière colonne occupée dans la feuille
DerCol = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'Trouve la dernière ligne de la dernière colonne
DerLig = .Columns(DerCol).Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
With Worksheets("Résultat")
'Col = la colonne que l'on va ajoutée
Col = Tbl.Range.Columns.Count + 1
Col2 = Tbl2.Range.Columns.Count + 1
'Ajoute une colonne Í la droite du tableau1
Tbl.ListColumns.Add(Col).Name = "Temp"
'Ajoute une colonne Í la droite du tableau12
Tbl2.ListColumns.Add(Col2).Name = "Temp"
'Places les données Í copier dans une variable (Array)
X = Sh.Range(Sh.Cells(1, DerCol), Sh.Cells(DerLig, DerCol))
Y = Sh.Range(Sh.Cells(1, 1), Sh.Cells(DerLig, DerCol - 1))
'Dans la colonne ajoutée au tableau1
With Tbl.Range(1, Col)
'copie des données
.Resize(UBound(X, 1), UBound(X, 2)).Value = X
End With
'Dans la colonne ajoutée au tableau2
With Tbl2.Range(1, Col2)
'copie des données
.Resize(UBound(Y, 1), UBound(Y, 2)).Value = Y
End With
'Attribue Í la colonne ajoutée le nom l'en-tête
'de la colonne copiée.
Tbl.ListColumns(Col).Name = Sh.Cells(1, DerCol)
Tbl2.ListColumns(Col2).Name = Sh.Cells(1, DerCol - 1)
End With
End If
End With
Next
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
'-----------------------------------------------
MichD

MichD

02/11/2020 à 16:35

Dans la macro soumise, tu dois ajouter un "sh." devant "name"
With Sh
'Si son nom d'onglet est différent de "Résultat"
If Sh.Name <> "Résultat" Then
Voir fichier exemple : https://www.cjoint.com/c/JKcpI1VYwCp
MichD

Yannick Son Vidéo

02/11/2020 à 16:49

Le lundi 2 novembre 2020 Í 16:35:17 UTC+1, MichD a écritÂ :

Dans la macro soumise, tu dois ajouter un "sh." devant "name"
With Sh
'Si son nom d'onglet est différent de "Résultat"
If Sh.Name <> "Résultat" Then
Voir fichier exemple : https://www.cjoint.com/c/JKcpI1VYwCp
MichD

j'utilise google sheet, le langage est-il différent ?
ou cette macro fonctionne que sur excel ?

MichD

02/11/2020 à 17:01

Le 02/11/20 Í 10:49, Yannick Son Vidéo a écritÂ :

Le lundi 2 novembre 2020 Í 16:35:17 UTC+1, MichD a écritÂ :
Dans la macro soumise, tu dois ajouter un "sh." devant "name"
With Sh
'Si son nom d'onglet est différent de "Résultat"
If Sh.Name <> "Résultat" Then
Voir fichier exemple : https://www.cjoint.com/c/JKcpI1VYwCp
MichD

j'utilise google sheet, le langage est-il différent ?
ou cette macro fonctionne que sur excel ?

Je ne connais pas google sheet, aucune idée sur ce sujet.
MichD

Yannick Son Vidéo

02/11/2020 à 17:37

Le lundi 2 novembre 2020 Í 17:01:39 UTC+1, MichD a écritÂ :

Le 02/11/20 Í 10:49, Yannick Son Vidéo a écrit :
Le lundi 2 novembre 2020 Í 16:35:17 UTC+1, MichD a écrit :
Dans la macro soumise, tu dois ajouter un "sh." devant "name"
With Sh
'Si son nom d'onglet est différent de "Résultat"
If Sh.Name <> "Résultat" Then
Voir fichier exemple : https://www.cjoint.com/c/JKcpI1VYwCp
MichD

j'utilise google sheet, le langage est-il différent ?
ou cette macro fonctionne que sur excel ?
Je ne connais pas google sheet, aucune idée sur ce sujet.
MichD

Je suis allé sur exceel j'ai entré le code dans l editeur microsoft visual basic, c'est bien lÍ , oÍ¹ il faut le mettre.
mais j'ai cette erreur.
Erreur d'exécution « 9 »:
L'indice est en dehors des dimensions du tableau

MichD

02/11/2020 à 17:54

Je suis allé sur exceel j'ai entré le code dans l editeur microsoft visual basic, c'est bien lÍ , oÍ¹ il faut le mettre.
mais j'ai cette erreur.
Erreur d'exécution « 9 »:
L'indice est en dehors des dimensions du tableau

Une erreur de type 9 fait référence Í un objet qui n'existe pas dans le
classeur.
Exemple :
Dim Sh As Worksheet
Si aucune feuille du classeur a comme nom d'onglet "Feuil2", la ligne de
code suivante génère une erreur de type 9. C'est vrai aussi pour le nom
des "tableaux".
Set Sh = Worksheets("Feuil2")
Comme j'ai mentionné, si le nom des objets est différent, tu dois
adapter la procédure en utilisant les noms réels des objets de ton
classeur, non ceux de mon fichier exemple.
MichD

MichD

02/11/2020 à 18:07

C'est la même procédure, tu n'as qu'Í définir les 3 variables du début
de la procédure selon les noms des objets de ton classeur.
'---------------------------------------------
Sub test()
Dim Sh As Worksheet, X As Variant
Dim DerCol As Long, DerLig As Long
Dim Tbl As ListObject, Col As Long
Dim Tbl2 As ListObject, Col2 As Long, Y As Variant
Dim NomFeuilleRésultat As String
Dim NomTableau1 As String
Dim NomTableau2 As String
'************Définir ces 3 variables*****************
'Nom de l'onglet oÍ¹ les données seront copiées
NomFeuilleRésultat = "Résultat"
'Le nom des 2 tableaux.
'Reçoit les données de la dernière colonne des feuilles
NomTableau1 = "Tableau1"
'Recoit les données l'avant-dernière colonne des feuilles
NomTableau2 = "Tableau2"
'************Définir ces 3 variables*****************
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Variable Tbl pointant vers le tableau1
Set Tbl = Worksheets(NomFeuilleRésultat).ListObjects(NomTableau1)
Set Tbl2 = Worksheets(NomFeuilleRésultat).ListObjects(NomTableau2)
'Boucle sur chacune des feuilles
For Each Sh In Worksheets
'Avec chacune des feuilles
With Sh
'Si son nom d'onglet est différent de "Résultat"
If Sh.Name <> NomFeuilleRésultat Then
'Trouve la dernière colonne occupée dans la feuille
DerCol = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'Trouve la dernière ligne de la dernière colonne
DerLig = .Columns(DerCol).Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
With Worksheets(NomFeuilleRésultat)
'Col = la colonne que l'on va ajoutée
Col = Tbl.Range.Columns.Count + 1
Col2 = Tbl2.Range.Columns.Count + 1
'Ajoute une colonne Í la droite du tableau1
Tbl.ListColumns.Add(Col).Name = "Temp"
'Ajoute une colonne Í la droite du tableau12
Tbl2.ListColumns.Add(Col2).Name = "Temp"
'Places les données Í copier dans une variable (Array)
X = Sh.Range(Sh.Cells(1, DerCol), Sh.Cells(DerLig, DerCol))
Y = Sh.Range(Sh.Cells(1, 1), Sh.Cells(DerLig, DerCol - 1))
'Dans la colonne ajoutée au tableau1
With Tbl.Range(1, Col)
'copie des données
.Resize(UBound(X, 1), UBound(X, 2)).Value = X
End With
'Dans la colonne ajoutée au tableau2
With Tbl2.Range(1, Col2)
'copie des données
.Resize(UBound(Y, 1), UBound(Y, 2)).Value = Y
End With
'Attribue Í la colonne ajoutée le nom l'en-tête
'de la colonne copiée.
Tbl.ListColumns(Col).Name = Sh.Cells(1, DerCol)
Tbl2.ListColumns(Col2).Name = Sh.Cells(1, DerCol - 1)
End With
End If
End With
Next
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
'---------------------------------------------
MichD

C'est la même procédure, tu n'as qu'Í définir les 3 variables du début
de la procédure selon les noms des objets de ton classeur.

'---------------------------------------------
Sub test()
Dim Sh As Worksheet, X As Variant
Dim DerCol As Long, DerLig As Long
Dim Tbl As ListObject, Col As Long
Dim Tbl2 As ListObject, Col2 As Long, Y As Variant
Dim NomFeuilleRésultat As String
Dim NomTableau1 As String
Dim NomTableau2 As String

'************Définir ces 3 variables*****************
'Nom de l'onglet oÍ¹ les données seront copiées
NomFeuilleRésultat = "Résultat"
'Le nom des 2 tableaux.
'Reçoit les données de la dernière colonne des feuilles
NomTableau1 = "Tableau1"
'Recoit les données l'avant-dernière colonne des feuilles
NomTableau2 = "Tableau2"
'************Définir ces 3 variables*****************

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

'Variable Tbl pointant vers le tableau1
Set Tbl = Worksheets(NomFeuilleRésultat).ListObjects(NomTableau1)
Set Tbl2 = Worksheets(NomFeuilleRésultat).ListObjects(NomTableau2)

'Boucle sur chacune des feuilles
For Each Sh In Worksheets
'Avec chacune des feuilles
With Sh
'Si son nom d'onglet est différent de "Résultat"
If Sh.Name <> NomFeuilleRésultat Then
'Trouve la dernière colonne occupée dans la feuille
DerCol = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'Trouve la dernière ligne de la dernière colonne
DerLig = .Columns(DerCol).Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

With Worksheets(NomFeuilleRésultat)
'Col = la colonne que l'on va ajoutée
Col = Tbl.Range.Columns.Count + 1
Col2 = Tbl2.Range.Columns.Count + 1
'Ajoute une colonne Í la droite du tableau1
Tbl.ListColumns.Add(Col).Name = "Temp"
'Ajoute une colonne Í la droite du tableau12
Tbl2.ListColumns.Add(Col2).Name = "Temp"
'Places les données Í copier dans une variable (Array)
X = Sh.Range(Sh.Cells(1, DerCol), Sh.Cells(DerLig, DerCol))
Y = Sh.Range(Sh.Cells(1, 1), Sh.Cells(DerLig, DerCol - 1))

'Dans la colonne ajoutée au tableau1
With Tbl.Range(1, Col)
'copie des données
.Resize(UBound(X, 1), UBound(X, 2)).Value = X
End With
'Dans la colonne ajoutée au tableau2
With Tbl2.Range(1, Col2)
'copie des données
.Resize(UBound(Y, 1), UBound(Y, 2)).Value = Y
End With

'Attribue Í la colonne ajoutée le nom l'en-tête
'de la colonne copiée.
Tbl.ListColumns(Col).Name = Sh.Cells(1, DerCol)
Tbl2.ListColumns(Col2).Name = Sh.Cells(1, DerCol - 1)
End With
End If
End With
Next
With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub
'---------------------------------------------

MichD

Vous avez filtré cet utilisateur ! Consultez son message

C'est la même procédure, tu n'as qu'Í définir les 3 variables du début
de la procédure selon les noms des objets de ton classeur.
'---------------------------------------------
Sub test()
Dim Sh As Worksheet, X As Variant
Dim DerCol As Long, DerLig As Long
Dim Tbl As ListObject, Col As Long
Dim Tbl2 As ListObject, Col2 As Long, Y As Variant
Dim NomFeuilleRésultat As String
Dim NomTableau1 As String
Dim NomTableau2 As String
'************Définir ces 3 variables*****************
'Nom de l'onglet oÍ¹ les données seront copiées
NomFeuilleRésultat = "Résultat"
'Le nom des 2 tableaux.
'Reçoit les données de la dernière colonne des feuilles
NomTableau1 = "Tableau1"
'Recoit les données l'avant-dernière colonne des feuilles
NomTableau2 = "Tableau2"
'************Définir ces 3 variables*****************
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Variable Tbl pointant vers le tableau1
Set Tbl = Worksheets(NomFeuilleRésultat).ListObjects(NomTableau1)
Set Tbl2 = Worksheets(NomFeuilleRésultat).ListObjects(NomTableau2)
'Boucle sur chacune des feuilles
For Each Sh In Worksheets
'Avec chacune des feuilles
With Sh
'Si son nom d'onglet est différent de "Résultat"
If Sh.Name <> NomFeuilleRésultat Then
'Trouve la dernière colonne occupée dans la feuille
DerCol = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'Trouve la dernière ligne de la dernière colonne
DerLig = .Columns(DerCol).Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
With Worksheets(NomFeuilleRésultat)
'Col = la colonne que l'on va ajoutée
Col = Tbl.Range.Columns.Count + 1
Col2 = Tbl2.Range.Columns.Count + 1
'Ajoute une colonne Í la droite du tableau1
Tbl.ListColumns.Add(Col).Name = "Temp"
'Ajoute une colonne Í la droite du tableau12
Tbl2.ListColumns.Add(Col2).Name = "Temp"
'Places les données Í copier dans une variable (Array)
X = Sh.Range(Sh.Cells(1, DerCol), Sh.Cells(DerLig, DerCol))
Y = Sh.Range(Sh.Cells(1, 1), Sh.Cells(DerLig, DerCol - 1))
'Dans la colonne ajoutée au tableau1
With Tbl.Range(1, Col)
'copie des données
.Resize(UBound(X, 1), UBound(X, 2)).Value = X
End With
'Dans la colonne ajoutée au tableau2
With Tbl2.Range(1, Col2)
'copie des données
.Resize(UBound(Y, 1), UBound(Y, 2)).Value = Y
End With
'Attribue Í la colonne ajoutée le nom l'en-tête
'de la colonne copiée.
Tbl.ListColumns(Col).Name = Sh.Cells(1, DerCol)
Tbl2.ListColumns(Col2).Name = Sh.Cells(1, DerCol - 1)
End With
End If
End With
Next
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
'---------------------------------------------
MichD

Macro et sélection dernière colonne

8 réponses

Veuillez sélectionner un problème