recuperation donnees d'une macro

Version imprimable

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:

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

Essaies ceci

Code:

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
Sub PerpaPrintPDF()
Dim WsS As Worksheet, WsC As Worksheet
Dim DerLigS As Long, DerLigC As Long, R As Long
Dim DerCol As Integer, C As Integer
Dim LeText As String
 
Set WsS = Sheets("Data")
Set WsC = Sheets("ToPrint")
WsC.UsedRange.Clear
DerLigS = WsS.Cells(WsS.Rows.Count, 1).End(xlUp).Row
DerLigC = 19
For R = 1 To DerLigS                                                 'Boucle sur les lignes col. A feuille Data
    DerCol = WsS.Cells(R, WsS.Columns.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, 2).Value = LeText
    Next C
Next R
Set WsS = Nothing
'Impression des commentaires pdf
With WsC
    With .Range("B19")
        .Value = "Nº Mobil Home - Date - et Commentaire"
        .Font.Size = 12
    End With
    .ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:="C:\A- archives Excel\Commentaires maintenance\Commentaires" & _
        Format(Now, "ddmmmmyyyy") & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    .UsedRange.Clear
End With
Set WsC = Nothing
End Sub

28/02/2011, 11h47
chris09300
merci mercatog
le code fonction tres bien.

j'ai changer la ligne ci dessous, car je souhaite faire un clear de B19, car au dessus j'ai une mise en page que je souhaite garder.
un info, stp j'utilise ce code
Code:

1 2 Sheets("ToPrint").Select [B19:L500].Clear
mais je pense qu'il doit y avoir une facon plus adequat que le select.

Code:

.UsedRange.Clear

autre question sans abuse.
dans mon userform je rentre un commentaire,
est il possible de demander qu'apres x mots il retourne a la ligne?

merci encore de tous ces renseignements
cris
28/02/2011, 12h12
mercatog

Sans la select

Code:

WsC.Range("B19:L500").Clear 'ou ClearContents