Rechercher une date sur deux feuilles et copier la colonne correspondante

Invité · 02/04/2012, 09h30

Bonjour,

J'ai un classeur excel avec deux onglets formant un calendrier sur l'année, le 1er onglet allant du 1er janvier au 31 juillet et le second du 1er aout au 31 janvier de l'année suivante. Chaque colonne correspondant à 1 jour de l'année.

J'aimerais copier dans une nouvelle feuille la colonne correspondant à la date du jour et les 27 colonnes suivantes (donc copier 4 semaines). Mon code vba fonctionne très bien sur un onglet :

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
With Sheets("Janvier-Juillet")
    Dim Col As Integer, Col2 As Integer
    Col = .Application.Match(Date * 1, .Rows(4), 0)
    Col2 = Col + 27
    If .Cells(4, Col2).Value = "" Then
        Col2 = Range("IV4").End(xlToLeft).Column
    End If
    Dim vrange As Range
    Set vrange = .Range(.Cells(4, Col), .Cells(29, Col2))
End With
 
vrange.Copy
 
 
Range("AB8").PasteSpecial Paste:=xlPasteValues
Range("AB8").PasteSpecial Paste:=xlPasteFormats

Ma question est la suivante. Comment faire pour qu'une fois le 31 juillet (de l'année en cours) passé on copie les colonnes de la feuille "Aout-Janvier"?
Et seconde question? Lorsque je suis au 20 juillet par exemple, il faudrait que je copie les colonnes du 20 au 31 juillet dans le 1er onglet pour du 1er aout au XX aout dans le second .... comment gérer ce changement d'onglet?

En résumé il faudrait que je cherche la date d'aujourd'hui sur les deux onglets et pas seulement sur un seul ... puis que je teste si ma Col2 est vide dans ce cas j'arrête ma vrange à la dernière colonne vide.

Je ne sais pas si je suis très clair, n'ayant pas vraiment d'idée sur comment réaliser cela, j'ai un peu de mal à m'exprimer.

**Philippe Tulliez** · 02/04/2012, 10h05

Bonjour,

J'ai un classeur excel avec deux onglets formant un calendrier sur l'année, le 1er onglet allant du 1er janvier au 31 juillet et le second du 1er aout au 31 janvier de l'année suivante. Chaque colonne correspondant à 1 jour de l'année.

En tête de colonne de ces deux feuilles qu'elle information a-t-on?
Une date, un chiffre, une donnée alpha-numérique et à quoi correspond-elle?

Invité · 02/04/2012, 11h09

J'affiche le chiffre avec la formule :
=DATE(ANNEE(AC1);MOIS(AC1);JOUR(AC1)) pour le 1er janvier (en cellule AC4)
Et
=DATE(ANNEE(AC4);MOIS(AC4);JOUR(AC4))+1 pour les colonnes suivantes

AC1 étant la date 01/01/2012

Donc dans ma ligne 4, j'affiche juste le chiffre du jour par exemple si on est le 31 janvier j'affiche la valeur 31 et le format de la cellule est personnalisé "jj;;" .... etc

**Philippe Tulliez** · 02/04/2012, 11h26

Bonjour,
Donc c'est une date.
Il suffit alors de faire une boucle de la colonne AC1, puisque cela semble être ta cellule de départ et arrêter la boucle dès que la valeur de la cellule est égale au 31/07/2012 et passer à la feuille suivante.
Difficile de t'aider plus parce-que tu écris

J'aimerais copier dans une nouvelle feuille la colonne correspondant à la date du jour et les 27 colonnes suivantes (donc copier 4 semaines)

et

Mon code vba fonctionne très bien sur un onglet :

Le code que tu as affiché est incomplet.
Pour changer de feuille un exemple mais encore une fois sans en savoir plus, c'est difficile

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub BoucleSemestre()
 Dim shtSem(1 To 2) As Worksheet
 Dim numSht As Byte
 With ThisWorkbook
  Set shtSem(1) = .Worksheets(shtSem1Name)
  Set shtSem(2) = .Worksheets(shtSem2Name)
 End With
 For numSht = 1 To 2
  '
  ' Ton code
  '
 Next
End Sub

Tu peux lire ou écrire directement sur tes feuilles par cette instruction shtSem(numSht).Range ("AC1")

[EDIT]
En fait, à la relecture de ta demande et si je comprends bien, tu souhaites lire les feuilles contenant les semestre 1 & 2 et recopier vers 1 ou plusieurs autres feuilles des cellules, mais lequelles, de chaque mois ?
Une feuille par mois ?

Invité · 02/04/2012, 11h43

Merci de ton aide et pour répondre à tes questions voici mon module au complet :

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
Function impression()
 
Sheets("Janvier-Juillet").Range("A5:AA29").Copy Destination:=Sheets("Impression").Range("A9")
 
Range("A9:AA40").Font.Size = 8
 
Next
 
With Sheets("Janvier-Juillet")
    Dim Col As Integer, Col2 As Integer
    Col = .Application.Match(Date * 1, .Rows(4), 0)
    Col2 = Col + 27
    If .Cells(4, Col2).Value = "" Then
        Col2 = Range("IV4").End(xlToLeft).Column
    End If
    Dim vrange As Range
    Set vrange = .Range(.Cells(4, Col), .Cells(29, Col2))
End With
 
 
vrange.Copy
 
 
Range("AB8").PasteSpecial Paste:=xlPasteValues
Range("AB8").PasteSpecial Paste:=xlPasteFormats
Range("AB8:BG40").Font.Size = 8
 
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True, Collate:=True
End Function

Je lance cette fonction grâce à un bouton situer sur la feuille que je veux imprimer (qui s'appelle "impression"). Et je souhaite copier les colonne correspondant à la date d'aujourd'hui + les 27 colonnes suivantes, mais si j'arrive au 31 juillet après ce sont des colonnes vides il faut donc que je copie les colonnes de ma feuille "Aout-Janvier" à la place des colonnes vides.
Mon code fonctionne uniquement pour copier la feuille "janvier-juillet" puisque nous sommes en mars, mais quand nous serons en juillet ... il y aura des problèmes.

Je vais tester ta proposition et je te dit si ça marche comme ça.

Invité · 04/04/2012, 08h20

J'ai suivi ton conseil et j'ai mis 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
Function impression()
 Dim shtSem(1 To 2) As Worksheet
 Dim numSht As Byte
 
 With ThisWorkbook
  Set shtSem(1) = .Worksheets("Janvier-Juillet")
  Set shtSem(2) = .Worksheets("Aout-Janvier")
 End With
 For numSht = 1 To 2
    Col = shtSem(numSht).Application.Match(Date * 1, shtSem(numSht).Rows(4), 0)
    shtSem(numSht).Range("A5:AA29").Copy Destination:=Sheets("Impression").Range("A9")
    Range("A9:AA40").Font.Size = 8
 '   Range("H1:P1").ClearContents
    For L = 1 To 34
     If Cells(L, 16).Value = 1 Then
         Cells(L, 16).ClearContents
         Cells(L, 13).Value = 5
         Cells(L, 14).Value = 2
     End If
    Next
    Col2 = Col + 27
    If shtSem(numSht).Cells(4, Col2).Value = "" Then
        Col2 = Range("IV4").End(xlToLeft).Column
    End If
    Dim vrange As Range
    Set vrange = shtSem(numSht).Range(shtSem(numSht).Cells(4, Col), shtSem(numSht).Cells(29, Col2))
 
 Next
 
 
vrange.Copy
 
 
Range("AB8").PasteSpecial Paste:=xlPasteValues
Range("AB8").PasteSpecial Paste:=xlPasteFormats
Range("AB8:BG40").Font.Size = 6
 
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True, Collate:=True
End Function

Mais j'ai eu une erreur sur la ligne commentée "Impossible de modifier une cellule fusionnée", après l'avoir commentée j'ai une erreur "incompatibilité de type" sur la ligne col2 = col + 27.

De plus à cause de la boucle la ligne

Code :

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

    shtSem(numSht).Range("A5:AA29").Copy Destination:=Sheets("Impression").Range("A9")

copie les valeurs de la deuxième feuille. Est-il possible de tester une date en vba, par exemple si date <31 juillet je copie shtSem(1) sinon shtSem(2)?

**Philippe Tulliez** · 04/04/2012, 12h45

Bonjour,
Ci-dessous une procédure qui lit et boucle sur deux feuilles semestrielles nommées Janvier-Juin & Juillet-decembre et dont les colonnes à lire commencent en B1.
Il suffit de modifier les constantes pour adapter le nom des feuilles et la référence à la cellule de départ.
Le programme lit donc toutes les cellules de la première ligne de la feuille du premier semestre et dès que le jour dépasse le dernier jour du mois de juin, recommence à la cellule B1 de la feuille du second semestre.
Il y a une création automatique des feuilles mensuelles portant le nom du mois et recopie de la cellule de la ligne 1

Ceci est bien évidemment un exemple d'une façon de procéder qui est proche de ce que tu cherches mais bien évidemment il faut l'adapter à tes besoins.
Attention, c'est une ébauche sans contrôle d'existence des feuilles. Par exemple si une feuille porte déjà le nom Février, il y aura un message d'erreur.

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
Option Explicit
Const shtSem1Name As String = "Janvier-Juin"
Const shtSem2Name As String = "Juillet-decembre"
Const startRng As String = "B1"  ' Cellule début de boucle
Sub BoucleSemestre()
 Dim shtSem(1 To 2) As Worksheet, rng As Range
 Dim shtMonth As Worksheet
 Dim numSht As Byte, col As Long
 Dim OldMonth As Byte
 With ThisWorkbook
  Set shtSem(1) = .Worksheets(shtSem1Name)
  Set shtSem(2) = .Worksheets(shtSem2Name)
 End With
 For numSht = 1 To 2 ' Parcourir feuille semestrielle
  col = 0 ' N° de colonne
  With shtSem(numSht).Range(startRng) ' Boucle feuille semestrielle
   Set rng = .Offset(0, col)
   While Month(rng) <= 6 * numSht ' Boucle sur les colonnes tant que le semestre n'est pas terminé
    ' Compare si le mois de la cellule est égale au mois de la cellule précédente
    If rng = 0 Then MsgBox "Problème ": Exit Sub
    If OldMonth <> Month(rng) Then
      ' Crée une nouvelle feuille mensuelle
      Sheets.Add After:=Sheets(Sheets.Count): ActiveSheet.Name = MonthName(Month(rng)): Set shtMonth = ActiveSheet
      OldMonth = Month(rng)
    End If
    shtMonth.Range("A" & Day(rng) + 1) = Format(rng.Value, "ddd dd/mm/yy")
   ' Le code pour copier vers la feuille du mois en cours de traitement
   '
   Debug.Print rng.Address & vbTab & rng
   col = col + 1: Set rng = .Offset(0, col)
   Wend
  End With
 Next numSht
End Sub

Invité · 04/04/2012, 14h53

Merci beaucoup pour ta réponse. j'ai tenté de l'adapter comme 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
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Option Explicit
Const shtSem1Name As String = "Janvier-Juillet"
Const shtSem2Name As String = "Aout-Janvier"
Const startRng As String = "AC4"  ' Cellule comportant la date du jour
Function impression()
 Dim shtSem(1 To 2) As Worksheet, rng As Range
 Dim numSht As Byte, col As Long, col2 As Long, feuille As Integer
 Dim OldMonth As Byte
 With ThisWorkbook
  Set shtSem(1) = .Worksheets(shtSem1Name)
  Set shtSem(2) = .Worksheets(shtSem2Name)
 End With
 For numSht = 1 To 2 ' Parcourir feuille semestrielle
  col = shtSem(numSht).Range("A4").EntireRow.Find(Date, LookAt:=xlWhole).Column ' N° de colonne pour aujourd'hui
 Next numSht
 col2 = col + 27
 
shtSem(feuille).Range("A5:AA29").Copy Destination:=Sheets("Impression").Range("A9")
Range("A9:AA40").Font.Size = 6
Dim L As Integer
For L = 1 To 34
    If Cells(L, 16).Value = 1 Then
        Cells(L, 16).ClearContents
        Cells(L, 13).Value = 5
        Cells(L, 14).Value = 2
    End If
Next
 
    If shtSem(feuille).Cells(4, col2).Value = "" Then
        col2 = Range("IV4").End(xlToLeft).Column
    End If
    Dim vrange As Range
    Set vrange = shtSem(feuille).Range(shtSem(feuille).Cells(4, col), shtSem(feuille).Cells(29, col2))
 
 
vrange.Copy
 
Range("AB8").PasteSpecial Paste:=xlPasteValues
Range("AB8").PasteSpecial Paste:=xlPasteFormats
Range("AB8:BG40").Font.Size = 6
 
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True, Collate:=True
End Function

Mais j'ai une erreur sur la ligne

Code :

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

  col = shtSem(numSht).Range("A4").EntireRow.Find(Date, LookAt:=xlWhole).Column ' N° de colonne pour aujourd'hui

ce qui ne m'étonne pas vraiment, mais je ne sais pas comment récupérer la date du jour en vba ... je sais qu'on peut utiliser Date, mais visiblement ça ne fonctionne pas avec Find, et une boucle sur toute la ligne me semble un peu lourd pour faire cela...

**Philippe Tulliez** · 04/04/2012, 15h06

Bonjour,
Je devrais visualiser ton classeur pour comprendre la manière dont il est organisé

**samuel50** · 04/04/2012, 16h22

Bonjour

Si je peux me permettre tu as une erreur car Find ne trouve pas la valeur recherché, pour éviter ce désagrément tu as deux possibilités.

1) utiliser la gestion d’erreur

Code :

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

1
2
3
4
5
6
For numSht = 1 To 2 ' Parcourir feuille semestrielle
  On Error Resume Next
  col = shtSem(numSht).Range("A4").EntireRow.Find(Date, LookAt:=xlWhole).Column ' N° de colonne pour aujourd'hui
 Next numSht
  On Error GoTo 0
  If col = 0 Then MsgBox "la date " & Date & "n'a pas été trouvé"

2) utiliser Find de manière plus conventionnelle

Code :

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

1
2
3
4
5
6
Dim rngcol As Range
 
For numSht = 1 To 2 ' Parcourir feuille semestrielle
  Set rngcol = shtSem(numSht).Range("A4").EntireRow.Find(Date, LookAt:=xlWhole)
  If Not rngcol Is Nothing Then col = rngcol.Column
Next numSht

J’espère avoir pu d’aider

Invité · 04/04/2012, 16h38

@Samuel j'ai une erreur d'éxécution objet requis sur la ligne du find avec ta solution =s

@corona voici le fichier avec le problème en question

**Philippe Tulliez** · 04/04/2012, 17h20

Bonjour,
J'ai regardé ton classeur et c'est bien ce que j'avais compris. Les cellules de AC4:IG4 contiennent bien une date.
Je ne comprenais pas la raison pour laquelle tu faisais le Find sur la date du jour.
Au lieu de faire un Find pour chercher le premier jour du mois, calcul son déplacement.
Etant donné que ton tableau commence le 1er jour de l'année, tu fais la différence entre le premier jour du mois en cours et le 1/01/2012 et ton déplacement est calculé.

Code :

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

1
2
3
4
5
6
Sub Calculdiff()
 Dim startdate As Date: startdate = "01/01/2012"
 Dim startMonth As Date: startMonth = DateSerial(Year(Date), Month(Date), 1)
 Debug.Print DateDiff("d", startdate, startMonth)
 Debug.Print Range("AC4").Offset(0, DateDiff("d", startdate, startMonth)).Address
End Sub

Que dois-tu placer dans la feuille IMPRIMER ?

Invité · 05/04/2012, 08h08

Bonjour,

Dans la feuille imprimer je veux afficher 27 colonnes à partir de la date d'aujourd'hui, si je clique aujourd'hui sur imprimer j'affiche mes colonnes du 5 avril au 2 mai environ. Mais je ne veux pas afficher le mois en cours, juste les 27 jours à venir... et mon plus gros problème sur ce code est de récupérer la colonne de la date du jour dans l'une ou l'autre des deux feuilles. Donc je ne cherche pas le premier jour du mois mais bien le numéro de la colonne correspondant à aujourd'hui. Le premier code que j'avais fait (cf mon 3ème post) fonctionne mais je le fais uniquement sur la feuille "janvier-juillet", donc une fois passé le 31 juillet je ne sais plus comment faire ...

Je vais essayer d'adapter le code que tu proposes, mais à quoi sert le debug.print exactement?

**Philippe Tulliez** · 05/04/2012, 08h30

Bonjour,
Si ton seul problème mais j'en doute au vu de ton code est de savoir sur quelle feuille tu dois commencer à aller chercher tes informations.
Voici un exemple par un simple calcul
On part du principe que les feuilles sont des variables Objets dimensionnées

Code :

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

1
2
3
4
5
6
 Const shtSem1Name As String = "Janvier-Juillet"
 Const shtSem2Name As String = "Aout-Janvier"
 With ThisWorkbook
  Set shtSem(1) = .Worksheets(shtSem1Name)
  Set shtSem(2) = .Worksheets(shtSem2Name)
 End With

Maintenant, sur quelle feuille faut-t'il aller chercher l'information, la 1 ou la 2 ?
Il y a une information que tu connais, c'est la date du jour.
La feuille 1 contient les dates du 1/1 au 31/7 et la 2 du 1/8 au 31/12
Donc il suffit d'additionner 1 avec une comparaison booléenne (LeMois>=7) qui renverra TRUE ou FALSE. True vaut -1 et False 0. En faisant Abs(LeMois>=7) J'obtiendrai 1 ou 0
Donc 1+0, c'est 1 et 1+1 c'est 2. Ce qui me donne le n° de la feuille
Petit exemple ci-dessous. LeMois c'est le n° du mois pour la simulation. En phase opérationnelle, c'est Month(Date)

Code :

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

1
2
3
4
5
6
7
Sub OuVaisJe()
 ' Debug.Print Month(Date)
 Dim LeMois As Byte, NumFile As Byte
 LeMois = 6
 NumFile = 1 + Abs((LeMois >= 7))
 Debug.Print NumFile
End Sub

Donc pour faire court

Code :

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

shtSem (1 + Abs((Month(Date) >= 7)))

Invité · 05/04/2012, 08h43

Merci beaucoup! Tu as raison je n'ai pas régler tout les problèmes mais déjà je n'ai plus d'erreur avec 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
Option Explicit
Const shtSem1Name As String = "Janvier-Juillet"
Const shtSem2Name As String = "Aout-Décembre"
Dim vrange As Range
Function impression()
 Dim shtSem(1 To 2) As Worksheet, rng As Range
 Dim numSht As Byte, col As Long, col2 As Long
 Dim OldMonth As Byte
 With ThisWorkbook
  Set shtSem(1) = .Worksheets(shtSem1Name)
  Set shtSem(2) = .Worksheets(shtSem2Name)
 End With
 
 With shtSem(1 + Abs((Month(Date) >= 7)))
    col = .Application.Match(Date * 1, .Rows(4), 0)
    col2 = col + 27
 
    .Range("A5:AA29").Copy Destination:=Sheets("Impression").Range("A9")
    Range("A9:AA40").Font.Size = 6
    Dim L As Integer
    For L = 1 To 34
        If Cells(L, 16).Value = 1 Then
            Cells(L, 16).ClearContents
            Cells(L, 13).Value = 5
            Cells(L, 14).Value = 2
        End If
    Next
 
    If .Cells(4, col2).Value = "" Then
        col2 = Range("IV4").End(xlToLeft).Column
    End If
 
    Set vrange = .Range(.Cells(4, col), .Cells(29, col2))
End With
 
    vrange.Copy
    Range("AB8").PasteSpecial Paste:=xlPasteValues
    Range("AB8").PasteSpecial Paste:=xlPasteFormats
    Range("AB8:BG40").Font.Size = 6
 
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True, Collate:=True
End Function

Maintenant il me reste à trouver une solution pour que lorsque j'arrive en juillet, je copie les colonnes de juillet et si j'arrive à une colonne vide je copie les colonnes de début aout.
quand tu dis :

Si ton seul problème mais j'en doute...

tu penses à des détails en particulier? j'accepte toute proposition d'amélioration, je sais que mon code n'est pas très optimisé.

**Philippe Tulliez** · 05/04/2012, 10h00

Bonjour,
Alors déjà remplacer Function Impression par Sub Impression.
Une fonction a pour but de renvoyer une valeur, une Sub est une procédure pour effectuer des actions.
J'ai aussi vu dans la procédure événementielle

Code :

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

1
2
3
Private Sub CommandButton1_Click()
    Application.Run (Imprimer.impression)
End Sub

Remplacer par

Code :

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

1
2
3
Private Sub CommandButton1_Click()
 Imprimer.impression
End Sub

Et tant que l'on y est, il est préférable pour la clareté du code et surtout pour la maintenance de faire précéder le nom d'un module d'une ou plusieurs lettres qui identifie que c'est un module. Moi je fais toujours précéder le nom de mes modules par un m minuscule. Par exemple mImprimer te permettra dans 6 mois de te rappeler que c'est un module.

Invité · 05/04/2012, 10h41

Merci pour tout ses conseils, je vais en tenir compte et modifier ces détails alors =).

Pour mon code je l'ai modifier et lorsqu'on arrive en juillet je copie bien la fin de juillet et le début d'aout, pour infos pour ceux que ça pourrait intéresser :

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
Option Explicit
Const shtSem1Name As String = "Janvier-Juillet"
Const shtSem2Name As String = "Aout-Décembre"
Dim vrange As Range, vrange2 As Range
Function impression()
 Range("AB8:BH8").ClearContents
 Dim shtSem(1 To 2) As Worksheet
 Dim numSht As Byte, col As Long, col2 As Long, col3 As Long, col4 As Long
 
 With ThisWorkbook
  Set shtSem(1) = .Worksheets(shtSem1Name)
  Set shtSem(2) = .Worksheets(shtSem2Name)
 End With
 With shtSem(1 + Abs((Month(Date) > 7)))
    col = .Application.Match(Date * 1, .Rows(4), 0)
    col2 = col + 27
 
    .Range("A5:AA29").Copy Destination:=Sheets("Impression").Range("A9")
    Range("A9:AA40").Font.Size = 6
    Dim L As Integer
    For L = 1 To 34
        If Cells(L, 16).Value = 1 Then
            Cells(L, 16).ClearContents
            Cells(L, 13).Value = 5
            Cells(L, 14).Value = 2
        End If
    Next
 
    If .Cells(4, col2).Value = "" Then
        col2 = .Range("IV4").End(xlToLeft).Column
        col3 = 29
        Dim intrmd As Integer
        intrmd = 256 - col2
        col4 = col3 + intrmd
        If (1 + Abs((Month(Date) > 7))) = 1 Then
            With shtSem(2)
                Set vrange2 = .Range(.Cells(4, col3), .Cells(29, col4))
            End With
        Else
            With shtSem(1)
                Set vrange2 = .Range(.Cells(4, col3), .Cells(29, col4))
            End With
        End If
    End If
    Set vrange = .Range(.Cells(4, col), .Cells(29, col2))
End With
 
    vrange.Copy
    Range("AB8").PasteSpecial Paste:=xlPasteValues
    Range("AB8").PasteSpecial Paste:=xlPasteFormats
    Selection.Font.Size = 6
    Dim fin As Long
    fin = Range("IV8").End(xlToLeft).Column + 1
    vrange2.Copy
    Cells(8, fin).PasteSpecial Paste:=xlPasteValues
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone
    Selection.Font.Size = 6
 
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True, Collate:=True
End Function

Encore merci pour ton aide corona!

**Philippe Tulliez** · 05/04/2012, 10h56

Bonjour,
Correction de ton code pour recherche du n° de colonne suivant la date.

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
Option Explicit
Const shtSem1Name As String = "Janvier-Juillet"
Const shtSem2Name As String = "Aout-Janvier"
Const startMonth2 As Byte = 8 ' N° de mois de la première date de la feuille 2
Const startRng As String = "AC4"  ' Cellule comportant la date du jour
Sub Impression()
 Dim shtSem(1 To 2) As Worksheet, rng As Range
 Dim numSht As Byte, col As Long, col2 As Long, feuille As Integer
 Dim offsetDay As Integer
 With ThisWorkbook
  Set shtSem(1) = .Worksheets(shtSem1Name)
  Set shtSem(2) = .Worksheets(shtSem2Name)
 End With
 
 '
 ' Lignes modifiéeé à supprimer
 'For numSht = 1 To 2 ' Parcourir feuille semestrielle
 ' col = shtSem(numSht).Range("A4").EntireRow.Find(Date, LookAt:=xlWhole).Column ' N° de colonne pour aujourd'hui
 'Next numSht
 'col2 = col + 27
 '
 Const xDate As Date = "30/07/2012"  ' *** xDate à enlever après les tests
 ' *** Après les test ne pas oublier de remplacer la constante xDate par Date sur les 2 lignes ci-dessous
 numSht = 1 + Abs((Month(xDate) >= startMonth2)) ' Numéro de la feuille date du jour
 col = shtSem(numSht).Range(startRng).Offset(0, offsetDay).Column
 MsgBox "Numéro de colonne : " & col & vbCrLf _
 & "Feuille : " & shtSem(numSht).Name

La constante xDate, te permet de faire des tests simulant la date du jour.
Une fois tes tests terminés, il suffit de supprimer la constante et ne pas oublier de remplacer xDate des 2 lignes qui suivent par Date

Je te laisse le soin de continuer parce-que ce qui suit est en erreur mais je crois que tu peux chercher le problème.

Invité · 05/04/2012, 11h06

Merci, j'ai effectué quelques tests pour vérifier le bon fonctionnement du code et ça marche, j'ai donc remis Date comme variable et c'est fini =)

Le code final est celui que j'ai mis dans mon post précédent (en modifiant function par sub)

Rechercher une date sur deux feuilles et copier la colonne correspondante

Macros et VBA Excel

Discussions similaires

Partager

Partager