Discussion :

[LabCert]

Merci à toutes les personnes qui m'ont apporté leur aide et des liens vers des tutoriels, guides et documentation de formation.

Cela aide beaucoup !

Cependant je bloque toujours pour ne pas utiliser des

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Select

Pour expliquer le besoin, j'ai un fichier Excel de référence qui sert de base de données (il sera à terme transformé en une véritable base de données): 9000 lignes et 300 colonnes.
Pour un ensemble de besoins, l'utilisateur trie les données de cette table grâce aux filtres. Cela permet d'afficher par exemple 3 lignes.

Ces 3 lignes et certaines des 300 colonnes seront transférées vers un autre tableau dans un autre fichier qui comporte des colonnes en plus (d'où le IF TransColP = "" Then).

Le tout étant vivant, le nom des colonnes peut changer !
Sur un onglet du fichier portant la macro, dans une autre feuille, un troisième tableau permet d'indiquer (transcodifier) le nom des colonnes des deux tableaux.
Par exemple: Dénomination (base de données) vs Référence (fichier de travail)

T_Ref.Port.TC:

N.Col.conv.TC	N.Col.conv.Po
Dénomination	Référence
Marque.	Trademark
Type d'appar.	Type d'appareil
...

La macro va donc traiter colonne par colonne pour copier l'ensemble des données vers le tableau final.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Option Explicit
 
Sub Extraction()
 
Application.ScreenUpdating = False
 
Dim Message As Integer
Dim NomClasseur As String
Dim TransColP As Range
Dim LienColTC As String
Dim NomCol As String
Dim RefnbLigne As Integer
 
NomClasseur = ActiveWorkbook.name
 
    For Each TransColP In Workbooks(NomClasseur).Sheets("Listes").Range("T_Ref.Port.TC[[N.Col.conv.Po]]")
        If TransColP = "" Then
            Else
            RefnbLigne = TransColP.Row - 1
            NomCol = TransColP.Text
            NomCol = "Tableau4[[" & NomCol & "]]"
            LienColTC = Workbooks(NomClasseur).Sheets("Listes").ListObjects("T_Ref.Port.TC").ListColumns("N.Col.conv.TC").DataBodyRange(RefnbLigne)
            LienColTC = "T_Tableau_TC[[" & LienColTC & "]]"
 
            Workbooks("Portail données.xlsx").Sheets("CHOD").Activate
            Range(NomCol).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Workbooks(NomClasseur).Sheets("TableauCaractéristiques").Activate
            Range(LienColTC).Select
                Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Next TransColP
 
Application.ScreenUpdating = True
 
End Sub

[mat955]

Bonjour,

Bien souvent, il suffit de "contracter" les écritures.
Par exemple, on peu remplacer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Range("A1").select
Selection.PasteSpecial XlPasteValues

Par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("A1").PasteSpecial XlPasteValues

Autre chose d'intéressant quand on utilise des filtres, il est possible en une seule instruction de sélectionner/copier uniquement les cellules visibles (= celles qui restent après avoir filtré), par exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Columns("A:C").SpecialCells(xlCellTypeVisible)

[LabCert]

Merci pour ces conseils Mat995

Cela fonctione :-D

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
    For Each TransColP In Workbooks(NomClasseur).Sheets("Listes").Range("T_Ref.Port.TC[[N.Col.conv.Po]]")
        If TransColP = "" Then
            Else
            RefnbLigne = TransColP.Row - 1
            NomCol = TransColP.Text
            NomCol = "Tableau4[[" & NomCol & "]]"
            LienColTC = Workbooks(NomClasseur).Sheets("Listes").ListObjects("T_Ref.Port.TC").ListColumns("N.Col.conv.TC").DataBodyRange(RefnbLigne)
            LienColTC = "T_Tableau_TC[[" & LienColTC & "]]"
            Workbooks("Portail données.xlsx").Sheets("CHOD").Range(NomCol).SpecialCells(xlCellTypeVisible).Copy
 
            Workbooks(NomClasseur).Sheets("TableauCaractéristiques").Range(LienColTC).PasteSpecial _
            Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Workbooks(NomClasseur).Sheets("TableauCaractéristiques").Range(LienColTC).PasteSpecial _
            Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
        End If
    Next TransColP

[LabCert]

LabCert;11867360]Merci pour ces conseils Mat995

Cela fonctione :-D

Oui, mes excuses à ceux qui auraient le message avant la mise à jour. J'avais une erreur de typographie.