Bonjour
j'ai des donnees sur une feuille Data de A1 a B500.
c'est donnees je souhaiterais les recuperees sur une autre feuille ToPrint
mais en B19, et cela s'affiche toujours en A1, j'ai le code suivant:



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
Option Explicit
 
Sub PerpaPrintPDF()
Dim WsS As Worksheet, WsC As Worksheet
Dim DerLigS As Long, DerLigC As Long, DerCol As Long, R As Long, C As Long
Dim LeText As String
 
Set WsS = Sheets("Data")
Set WsC = Sheets("ToPrint")
WsC.Cells.Clear
DerLigS = WsS.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
DerLigC = 0
 
For R = 1 To DerLigS 'Boucle sur les lignes col. A feuille Data
    DerCol = WsS.Cells(R, Rows(R).Cells.Count).End(xlToLeft).Column
    For C = 2 To DerCol
        DerLigC = DerLigC + 1
        If WsS.Cells(R, C).Comment Is Nothing Then
            LeText = WsS.Cells(R, 1).Value & " - " & WsS.Cells(R, C).Value & " - No Comment"
        Else
            LeText = WsS.Cells(R, 1).Value & "   -   " & WsS.Cells(R, C).Value & "   -   " & WsS.Cells(R, C).Comment.Text
        End If
        WsC.Cells(DerLigC, 1) = LeText
    Next C
Next R
 
'Impression des commentaires pdf
 
Dim mois As String
Dim année As String
Dim jour As String
 
jour = Format(Now, "dd")
mois = Format(Now, "mmmm")
année = Format(Now, "yyyy")
Sheets("ToPrint").Select
    Range("B21").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    [B19] = "Nº Mobil Home - Date - et Commentaire"
    With ActiveCell.Characters(Start:=1, Length:=37).Font
        .Size = 12
     End With
'Range("A21").Select
 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"c:\A- archives Excel\Commentaires maintenance\" & "Commentaires" & " " & jour & " " & mois & " " & année & " ", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=True
 
  [B19:L500].Clear
 
Sheets("Data").Select
[A1].Select
End Sub

cris