Discussion :

[Henri1830]

Rebonjour,

J'enrage, j'ô désespoir !
Après avoir passé l'écueil du find, voilà que je me casse les dents sur l'instruction suivante :

Code :

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

    Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(1, 1), Cells(1, 2)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(1, 1), Cells(1, 2))

J'ai tout vérifié, toutes les variables sont valorisées, je ne vois rien d'anormal.

J'ai même essayé de changer pour

Code :

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

Worksheets(TsrTabEnvoiManuel).Range(Cells(1, 1), Cells(1, 2)).Copy Destination:=Worksheets(RapTabDetails).Range(Cells(1, 1), Cells(1, 2))

mais tout ce que ça fait, c'est changer d'erreur pour "Erreur d'exécution 9 - l’indice n’appartient pas à la sélection"

Y a-t-il une lumière au bout de ce tunnel ?

Merci d'avance pour votre coup de main.

Henri

[anasecu]

Bonjour,

Pourquoi "range" ?
cells est sufisant

[Henri1830]

Si j'enlève "Range" je ne peux même pas exécuter le code.
Une précision peut-être ?

[Franc]

Bonjour, c'est pas évident d'aider quand on n'a qu'une ligne de code qui n'est peut-être pas à l'origine de l'erreur, il faudrait au minimum la macro complète.

[Henri1830]

La voici :

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
    'Declare Variables
    Dim TsrFichOri As String, TsrTabEnvoiManuel As String, RefClient As String
    Dim strInputBox As String
    Dim wb As Workbook, ws As Worksheet
    Dim rowNumber As Long, myDate As Date
    Dim EmailClient As String, NomClient As String, ComStru As String
    Dim Montant As String, FirstDate As Date
    Dim RapFichDes As String
    Dim RapTabDetails As String
    Dim RapDisqDes As String
    Dim RapRepDes As String
    Dim FirstRow As Currency, CrtRow As Currency, LastRow As Currency
 
    RapDisqDes = "S:\"
    RapRepDes = "Dossiers C&C\Listes\Rappels\Rappels envoyés\"
 
    'Initialize Variables
    Range("A1").Activate
    TsrFichOri = ActiveWorkbook.Name
    TsrTabEnvoiManuel = "Envoi manuel"
    Windows(TsrFichOri).Activate
    Worksheets(TsrTabEnvoiManuel).Activate
 
    'https://www.automateexcel.com/vba/inputbox-function/
    'Prompt User for Client Reference
    'RefClient = [inputbox](/vba/input-box-macro/)("Enter Client Reference: ", "Client Reference", ActiveCell.Value)
    RefClient = InputBox("Veuillez entrer la référence du client", "Input required")
 
    'Exit Macro if User Presses Cancel
    If RefClient = "" Then Exit Sub
 
    'Find first row with reference
    'https://www.automateexcel.com/excel/find-all-instances-with-vba/
    rowNumber = Columns(1).Find(What:=RefClient, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
    FirstDate = Cells(rowNumber, 6).Value
    FirstRow = ActiveCell.Row
    'Find row with "Total " & RefClient
    rowNumber = Columns(1).Find(What:="Total " & RefClient, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
    'Extract necessary values
    EmailClient = Cells(rowNumber, 3).Value
    NomClient = Cells(rowNumber, 4).Value
    Montant = Cells(rowNumber, 11).Value
    ComStru = Cells(rowNumber - 1, 12).Value
    LastRow = ActiveCell.Row
 
    'Copy Headline from Original Workbook to New Workbook
    RapFichDes = NomClient & " - Rappel 1 au " & Format(Date, "YYYY MM DD") & ".xlsx"
    Workbooks.Add.SaveAs Filename:=RapDisqDes & RapRepDes & RapFichDes
    RapTabDetails = "Details Prestations"
    ActiveSheet.Name = RapTabDetails
 
    Windows(TsrFichOri).Activate
    Worksheets(TsrTabEnvoiManuel).Activate
'    Range("F2").Copy Destination:=Range(Cells(2, 6), Cells(CliNbMaxLigne, 6))
'    Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(1, 1), Cells(1, 2)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(1, 1), Cells(1, 2))
'    Worksheets(TsrTabEnvoiManuel).Range(Cells(1, 1), Cells(1, 2)).Copy Destination:=Worksheets(RapTabDetails).Range(Cells(1, 1), Cells(1, 2))
    Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(1, 4), Cells(1, 6)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(1, 3), Cells(1, 5))
    Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(1, 8), Cells(1, 11)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(1, 6), Cells(1, 9))
    Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(1, 13), Cells(1, 14)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(1, 10), Cells(1, 11))

[Philippe Tulliez]

Bonjour,
Problème classique.
Dans la ligne de code ci-dessous, L'objet Cells n'étant pas rattaché à son parent, il est considéré comme faisant partie de la feuille active

Code :

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

Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(1, 4), Cells(1, 6)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(1, 3), Cells(1, 5))

Vous pouvez remplacer cette ligne par ces lignes (écrit de mémoire, pas testé)

Code :

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

1
2
3
4
5
6
7
  With Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel)
    Set rngSource = .Range(.Cells(1, 4), .Cells(1, 6))
  End With
  With Workbooks(apFichDes).Worksheets(RapTabDetails)
    Set rngTarget = .Range(.Cells(1, 3), .Cells(1, 5))
  End With
  rngSource.Copy Destination:=rngTarget

[Franc]

La macro ne provoque aucune erreur à la compilation donc il faudrait le classeur pour tester l'exécution.
A la lecture du code, je me permets quelques remarques qui pourraient être source d'erreurs potentielles.

- La macro suppose que la valeur recherchée (RefClient) se trouve toujours dans la colonne 1. Si ce n’est pas le cas, cela pourrait entraîner des erreurs.
- La macro ne gère pas les erreurs qui pourraient survenir si la valeur recherchée (RefClient) n’est pas trouvée. Vous pourriez envisager d’ajouter une gestion d’erreur pour cela.
- La macro utilise ActiveWorkbook, ActiveSheet, et ActiveCell. L’utilisation de ces références actives peut parfois conduire à des erreurs si le classeur, la feuille ou la cellule active change pendant l’exécution de la macro. Il serait plus sûr de référencer explicitement les classeurs, les feuilles et les cellules.
- La variable myDate est déclarée mais jamais utilisée. Si elle n’est pas nécessaire, vous pouvez la supprimer.
- Les variables FirstRow, CrtRow et LastRow sont déclarées en tant que Currency. Habituellement, pour les numéros de ligne, on utilise le type Long.
- La macro ne ferme pas le classeur qu’elle crée (RapFichDes). Si vous voulez fermer ce classeur à la fin de la macro, vous devriez ajouter cette étape.

[Henri1830]

Cher Philippe,

Une fois de plus, vous me tirez d'un mauvais pas.
Evidemment merci, mais j'ai encore une question :
Il y a plusieurs copies à faire pour les titres et une boucle pour une série de données.

Ce que j'avais imaginé (mais qui ne fontionne pas) était ceci :

Code :

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

1
2
3
4
'    Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(1, 1), Cells(1, 2)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(1, 1), Cells(1, 2))
'    Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(1, 4), Cells(1, 6)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(1, 3), Cells(1, 5))
'    Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(1, 8), Cells(1, 11)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(1, 6), Cells(1, 9))
'    Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(1, 13), Cells(1, 14)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(1, 10), Cells(1, 11))

Comment puis-je transformer cela "à votre mode" ?

D'autre part, une fois que les titres sont en place, il me faut copier une partie des données du fichier source dans le fichier de destination et pour ce faire, j'avais pensé à ceci :

Code :

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

1
2
3
4
5
6
    For CrtRow = FirstRow To LastRow
        Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(CrtRow, 1), Cells(CrtRow, 2)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(CrtRow, 1), Cells(CrtRow, 2))
        Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(CrtRow, 4), Cells(CrtRow, 6)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(CrtRow, 3), Cells(CrtRow, 5))
        Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(CrtRow, 8), Cells(CrtRow, 11)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(CrtRow, 6), Cells(CrtRow, 9))
        Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(CrtRow, 13), Cells(CrtRow, 14)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(CrtRow, 10), Cells(CrtRow, 11))
    Next CrtRow

J'imagine que cela ne fonctionnera pas plus que les précédents, donc même question.

Je suis à la fois confus et ravi de pouvoir faire appel à vous mais en tout cas, très reconnaissant.

Je vous souhaite une excellente soirée et de même pour le week-end qui s'annonce.

Henri

[Henri1830]

Cher Franc,

Mille mercis pour vos conseils.
Vous n'avez pas tout le code, il se poursuit plus loin mais je ne manquerai pas de mettre vos judicieux conseils en pratique.

Je vous souhaite une bonne soirée et un bon week-end.

Bien à vous

Henri

[Philippe Tulliez]

Bonjour Henri,
Voici ma proposition
Attention écrit de mémoire donc non testé

Code :

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

1
2
3
4
5
6
7
8
9
  Dim shtTarget As Worksheet
  Set shtTarget = Workbooks(RapFichDes).Worksheets(RapTabDetails)
  For CrtRow = FirstRow To LastRow
   With Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel)
   .Range(.Cells(CrtRow, 1), .Cells(CrtRow, 2)).Copy Destination:=shtTarget.Range(shtTarget.Cells(CrtRow, 1), shtTarget.Cells(CrtRow, 2))
   .Range(.Cells(CrtRow, 4), .Cells(CrtRow, 6)).Copy Destination:=shtTarget.Range(shtTarget.Cells(CrtRow, 3), shtTarget.Cells(CrtRow, 5))
   .Range(.Cells(CrtRow, 8), .Cells(CrtRow, 11)).Copy Destination:=shtTarget.Range(shtTarget.Cells(CrtRow, 6), shtTarget.Cells(CrtRow, 9))
   .Range(.Cells(CrtRow, 13), .Cells(CrtRow, 14)).Copy Destination:=shtTarget.Range(shtTarget.Cells(CrtRow, 10), shtTarget.Cells(CrtRow, 11))
  Next CrtRow

Il y a certainement plus simple et plus concis mais je n'ai pas le temps à consacrer à cela aujourd'hui.

[deedolith]

Hello,

Franchement, quand je voit une instruction comme celle ci:

Code :

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

Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel).Range(Cells(CrtRow, 1), Cells(CrtRow, 2)).Copy Destination:=Workbooks(RapFichDes).Worksheets(RapTabDetails).Range(Cells(CrtRow, 1), Cells(CrtRow, 2))

Ouch !

Fait toi une fleur: Décompose.
Tu y gagnera en lisibilité et en maintenabilité.
Exemple:

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
Dim SourceWb As Excel.workbook
Set SourceWb = Workbooks(TsrFichOri)
 
Dim SourceWs As Excel.Worksheet
Set SourceWs = SourceWb.Worksheets(TsrTabEnvoiManuel)
 
Dim SourceRng As Excel.Range
Set sourceRng = SourceWs.Range(SourceWs.Cells(CrtRow, 1), SourceWs.Cells(CrtRow, 2))
 
Dim TargetWb As Excel.Workbook
Set TargetWb = Workbooks(RapFichDes)
 
Dim TargetWs As Excel.Worksheet
Set TargetWs = TargetWb.Worksheets(RapTabDetails)
 
Set TargetRng As Excel.Range
Set TargetRng = TargetWs.Range(TargetWs.Cells(CrtRow, 1), TargetWs.Cells(CrtRow, 2))
 
SourceRng.Copy Destination:=TargetRng

[Henri1830]

Cher Philippe,

Désolé d'avoir mis tant de temps à réagir, mais j'ai dû sprinter pour sortir une version acceptable ce soir et grâce à vous ; c'est fait !
Je ne sais plus comment vous dire merci... Dank u wel peut-être ?

Je vous laisse le code pour info.
Je suis sûr que vous auriez fait plus clair, plus court, plus rapide et plus sympa, mais bon, ça tourne et pour le moment c'est l'essentiel.

Je ne suis pas plus bête qu'un autre mais je développe tout cela sans avoir suivi de formation et sans prendre le temps d'en suivre une, en plus.
J'aimerais pourtant bien être un peu moins "copier/coller" sans comprendre les tenants et les aboutissants et un peu plus structuré et cohérent.

Ça viendra ; la queue du chat est bien venue...

Bon ben, merci ! Dank u ! Thank you ! Aksanti sana ! dhanyavaad ! Vielen Dank, etc...

Je ne sais pas où vous allez chercher le temps, la patience et la bienveillance, mais je pense que la moitié de la planète "développement VBA" doit vous être reconnaissant. Encore merci.

Henri

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
Sub Rappel()
 
    'Declare Variables
    Dim TsrFichOri As String, TsrTabEnvoiManuel As String, RefClient As String
    Dim strInputBox As String
    Dim rowNumber As Long
    Dim EmailClient As String, NomClient As String, ComStru As String
    Dim Montant As Currency
    Dim FirstDate As Date
    Dim RapFichDes As String, RapFichDesPDF As String
    Dim RapTabDetails As String
    Dim RapDisqDes As String
    Dim RapRepDes As String
    Dim FirstRow As Currency, CrtRow As Currency, LastRow As Currency
 
    RapDisqDes = "S:\"
    RapRepDes = "Dossiers C&C\Listes\Rappels\Rappels envoyés\"
 
    'Initialize Variables
    Range("A1").Select
    TsrFichOri = ActiveWorkbook.Name
    TsrTabEnvoiManuel = "Envoi manuel"
    Windows(TsrFichOri).Activate
    Worksheets(TsrTabEnvoiManuel).Activate
 
    RefClient = InputBox("Veuillez entrer la référence du client", "Module d'envoi de rappel")
 
    'Exit Macro if User Presses Cancel
    If RefClient = "" Then Exit Sub
 
    'Find first row with reference
    'https://www.automateexcel.com/excel/find-all-instances-with-vba/
    ActiveSheet.Outline.ShowLevels RowLevels:=3
    rowNumber = Columns(1).Find(What:=RefClient, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    Rows(rowNumber).ShowDetail = True
    FirstDate = Cells(rowNumber, 6).Value
    FirstRow = rowNumber
 
    'Find row with "Total " & RefClient
    rowNumber = Columns(1).Find(What:="Total " & RefClient, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
 
    'Extract necessary values
    EmailClient = Cells(rowNumber, 3).Value
    NomClient = Cells(rowNumber, 4).Value
    Montant = Cells(rowNumber, 11).Value
    ComStru = Cells(rowNumber - 1, 12).Value
    LastRow = rowNumber
 
    'Copy Headline from Original Workbook to New Workbook
    RapFichDes = NomClient & " - Rappel 1 au " & Format(Date, "YYYY MM DD") & ".xlsx"
    RapFichDesPDF = NomClient & " - Rappel 1 au " & Format(Date, "YYYY MM DD") & ".pdf"
    Workbooks.Add.SaveAs Filename:=RapDisqDes & RapRepDes & RapFichDes
    RapTabDetails = "Details Prestations"
    ActiveSheet.Name = RapTabDetails
 
    Dim shtTarget As Worksheet
    Set shtTarget = Workbooks(RapFichDes).Worksheets(RapTabDetails)
        With Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel)
        .Range(.Cells(1, 1), .Cells(1, 2)).Copy Destination:=shtTarget.Range(shtTarget.Cells(1, 1), shtTarget.Cells(1, 2))
        .Range(.Cells(1, 4), .Cells(1, 6)).Copy Destination:=shtTarget.Range(shtTarget.Cells(1, 3), shtTarget.Cells(1, 5))
        .Range(.Cells(1, 8), .Cells(1, 11)).Copy Destination:=shtTarget.Range(shtTarget.Cells(1, 6), shtTarget.Cells(1, 9))
        .Range(.Cells(1, 13), .Cells(1, 14)).Copy Destination:=shtTarget.Range(shtTarget.Cells(1, 10), shtTarget.Cells(1, 11))
        End With
 
    For CrtRow = FirstRow To LastRow
        With Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel)
         If CrtRow < LastRow Then
            .Range(.Cells(CrtRow, 1), .Cells(CrtRow, 2)).Copy Destination:=shtTarget.Range(shtTarget.Cells(CrtRow - FirstRow + 2, 1), shtTarget.Cells(CrtRow - FirstRow + 2, 2))
            .Range(.Cells(CrtRow, 4), .Cells(CrtRow, 6)).Copy Destination:=shtTarget.Range(shtTarget.Cells(CrtRow - FirstRow + 2, 3), shtTarget.Cells(CrtRow - FirstRow + 2, 5))
         End If
        .Range(.Cells(CrtRow, 8), .Cells(CrtRow, 11)).Copy Destination:=shtTarget.Range(shtTarget.Cells(CrtRow - FirstRow + 2, 6), shtTarget.Cells(CrtRow - FirstRow + 2, 9))
        .Range(.Cells(CrtRow, 13), .Cells(CrtRow, 14)).Copy Destination:=shtTarget.Range(shtTarget.Cells(CrtRow - FirstRow + 2, 10), shtTarget.Cells(CrtRow - FirstRow + 2, 11))
        End With
    Next CrtRow
    With shtTarget.Range(shtTarget.Cells(2, 9), shtTarget.Cells(CrtRow - FirstRow, 9))
    .FormulaR1C1 = "=IF(TODAY()-RC[-4]>365,RC[-1]*28.98,RC[-1]*10)"
    .Copy: .PasteSpecial Paste:=xlPasteValues
    End With
    Application.CutCopyMode = False
 
    With shtTarget.Range(shtTarget.Cells(LastRow + 2 - FirstRow, 6), shtTarget.Cells(LastRow + 2 - FirstRow, 9))
    .Copy: .PasteSpecial Paste:=xlPasteValues
    End With
    Application.CutCopyMode = False
 
 
    ' Mise en forme du fichier
    With shtTarget.Columns("B:K")
    .EntireColumn.AutoFit
    End With
 
    With shtTarget.Columns("I:I")
    .Style = "Currency"
    End With
 
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False ' force le contenu à s'adapter aux dimensions de la cellule
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
    Range("A1").ColumnWidth = 5
 
'    Définition du périmètre à imprimer
    ActiveSheet.PageSetup.Orientation = xlLandscape ' Orientation paysage
    ActiveSheet.PageSetup.PrintArea = Range(Cells(1, 1), Cells(LastRow + 2 - FirstRow, 11)).Address
'   Impression de la feuille en PDF.
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=RapDisqDes & RapRepDes & RapFichDesPDF, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
 
 
End Sub ' Rappel()

[Henri1830]

Cher deedolith,

Mille mercis pour le conseil ; comme je le disais plus avant à Philippe, je suis plus copier/coller que structure et projet construit.
Je ne demande pas mieux que de me structurer mais je parviens à peine à faire ce qui est l'indispensable, donc, le luxe d'un cours dont j'aurais bien besoin, n'entre pas dans le calendrier pour le moment.

Merci pour la proposition de structure, je vois bien l'intérêt, ça vaut la peine.

Merci encore et bonne journée !

Henri

[Henri1830]

Au fait deedolith, une question :
avec ce code

Code :

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

1
2
3
4
5
6
7
8
...
Dim SourceRng As Excel.Range
Set sourceRng = SourceWs.Range(SourceWs.Cells(CrtRow, 1), SourceWs.Cells(CrtRow, 2))
....
Set TargetRng As Excel.Range
Set TargetRng = TargetWs.Range(TargetWs.Cells(CrtRow, 1), TargetWs.Cells(CrtRow, 2))
 
SourceRng.Copy Destination:=TargetRng

Comment je fais pour arriver à faire ceci :

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
    Dim shtTarget As Worksheet
    Set shtTarget = Workbooks(RapFichDes).Worksheets(RapTabDetails)
        With Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel)
        .Range(.Cells(1, 1), .Cells(1, 2)).Copy Destination:=shtTarget.Range(shtTarget.Cells(1, 1), shtTarget.Cells(1, 2))
        .Range(.Cells(1, 4), .Cells(1, 6)).Copy Destination:=shtTarget.Range(shtTarget.Cells(1, 3), shtTarget.Cells(1, 5))
        .Range(.Cells(1, 8), .Cells(1, 11)).Copy Destination:=shtTarget.Range(shtTarget.Cells(1, 6), shtTarget.Cells(1, 9))
        .Range(.Cells(1, 13), .Cells(1, 14)).Copy Destination:=shtTarget.Range(shtTarget.Cells(1, 10), shtTarget.Cells(1, 11))
        End With
 
    For CrtRow = FirstRow To LastRow
        With Workbooks(TsrFichOri).Worksheets(TsrTabEnvoiManuel)
         If CrtRow < LastRow Then
            .Range(.Cells(CrtRow, 1), .Cells(CrtRow, 2)).Copy Destination:=shtTarget.Range(shtTarget.Cells(CrtRow - FirstRow + 2, 1), shtTarget.Cells(CrtRow - FirstRow + 2, 2))
            .Range(.Cells(CrtRow, 4), .Cells(CrtRow, 6)).Copy Destination:=shtTarget.Range(shtTarget.Cells(CrtRow - FirstRow + 2, 3), shtTarget.Cells(CrtRow - FirstRow + 2, 5))
         End If
        .Range(.Cells(CrtRow, 8), .Cells(CrtRow, 11)).Copy Destination:=shtTarget.Range(shtTarget.Cells(CrtRow - FirstRow + 2, 6), shtTarget.Cells(CrtRow - FirstRow + 2, 9))
        .Range(.Cells(CrtRow, 13), .Cells(CrtRow, 14)).Copy Destination:=shtTarget.Range(shtTarget.Cells(CrtRow - FirstRow + 2, 10), shtTarget.Cells(CrtRow - FirstRow + 2, 11))
        End With
    Next CrtRow