Effectuer des contrôles

Question

Bonjour, 

J'effectue tous les mathins les mêmes contrôles sur une feuille excel. Je ne supporte plus de faire la même chose!!! Débutant en programmation VBA je voudrais commencer par une macro toute simple pour l'étoffer petit à petit. 

Je voudrais donc commencer par le premier contrôle que je fais: 

Vérifier que mon tableau ne fasse pas plus de 1000 lignes. Si c'est bon, je duplique ma feuille Excel par autant de points de ventes présents. J'ai deux macros qui marchent parfaitement:

Macro 1: 

Private Sub CommandButton1_Click()
Dim RgT As Range, N As Long, C As Long, FeuiR As Worksheet
Set RgT = Feuil1.[H8].CurrentRegion
Set RgT = Range(Feuil1.Rows(8), RgT.Rows(RgT.Rows.Count))
If RgT.Rows.Count > 1000 Then MsgBox "Le tableau comporte plus de 1000 lignes"
End Sub

Macro 2

Private Sub CommandButton1_Click()
Dim RgT As Range, N As Long, C As Long, FeuiR As Worksheet
For C = 15 To 256
RgT = Cells(6, C).Value
If RgT = "" Then
Exit For
End If
Set FeuiR = Worksheets.Add
FeuiR.Name = RgT
Feuil1.Columns(1).Resize(, 14).Copy FeuiR.Columns(1)
Feuil1.Columns(C).Copy FeuiR.Columns(15)
Next C
End Sub

Voici la compilation de mes 2 macros:

Private Sub CommandButton1_Click()
Dim RgT As Range, N As Long, C As Long, FeuiR As Worksheet
Set RgT = Feuil1.[H8].CurrentRegion
Set RgT = Range(Feuil1.Rows(8), RgT.Rows(RgT.Rows.Count))
If RgT.Rows.Count > 1000 Then MsgBox "Le tableau comporte plus de 1000 lignes"
For C = 15 To 256
RgT = Cells(6, C).Value
If RgT = "" Then
Exit For
End If
Set FeuiR = Worksheets.Add
FeuiR.Name = RgT
Feuil1.Columns(1).Resize(, 14).Copy FeuiR.Columns(1)
Feuil1.Columns(C).Copy FeuiR.Columns(15)
Next C
End Sub


Lorsque je la lance j'ai un message d'erreur qui s'affiche: erreur'13', incompatibilié de type. C'est au niveau de la syntaxe que ca doit coincer.

Quelqu'un peut-il me donner un coup de main? 

Cordialement,

Le_Goret

Configuration: Windows XP / Internet Explorer 7.0

michel_m · Answer

Bonjour

RgT est bizarre...

rgt est dékarée en Range

Et là
RgT = Cells(6, C).Value  si tu demande la valeur Rgt n'est plus une "range" ==> incompatibilité de type

mais ta macro parait bien compliqué...

Le_Goret · Answer

Les bureaux sont bien vides en ce vendredi matin. Je fais un tour sur les forums et je me rends compte que j'ai publié des posts que je ne suis plus allé voir par la suite.  
Je suis bien arrivé à finaliser cette macro. A partir d'une base de données cette macro va créer un onglet spécifique à chaque colonne. Chaque ligne dont une valeur est à 0 est supprimée. J'ai apporté une nouvelle modification: un tableau croisé dynamique est crée pour chacun de ces onglets. Voici le code ca peut aider quelqu'un.  
Voici ma maquette. Il suffit de cliquer sur le premier bouton contrôle.  

http://www.cijoint.fr/cjlink.php?file=cj201104/cijFFxD0Yd.xls  


Private Sub CommandButton1_Click() 
Dim RgT As String, N As Long, C As Long, FeuiR As Worksheet 
Dim Adr As String 'Source 
Dim Adr1 As String 'Destination 
Dim PT As PivotTable 
For C = 15 To 256 
RgT = Cells(6, C).Value 
If RgT = "" Then 
Exit For 
End If 
Set FeuiR = Worksheets.Add 
FeuiR.Name = RgT 
Feuil1.Columns(1).Resize(, 14).Copy FeuiR.Columns(1) 
Feuil1.Columns(C).Copy FeuiR.Columns(15) 
Set FeuiR = Worksheets.Add 
FeuiR.Name = RgT & "TCD" 


'suppression des lignes avec quantités a zero 
Sheets(RgT).Select 
Sheets(RgT).Activate 
'With Worksheets(RgT) 
Dim dl As Integer 'déclare la variable dl 
Dim x As Integer 'déclare la variable x 

dl = Range("I65536").End(xlUp).Row 'définit la variable x (dernière ligne remplie (colonne à adapter)) 
For x = dl To 8 Step -1 
    'si la cellule de la ligne x, colonne 15 ("I") est nulle, supprime la ligne 
    If Sheets(RgT).Cells(x, 15).Value = 0 Then 
        Sheets(RgT).Rows(x).Delete 
    End If 
Next x 'prochaine ligne de la boucle 
'End With 

' Tableaucroisédynamique Macro 
Name = "Tcd " & C 
Dest = RgT & "!A3" 
Sheets(RgT).Select 
'Définir où sera copié le pivottable 
With Worksheets(RgT) 
    Adr1 = .Name & "TCD!" & .Range("A3").Address 
End With 

'Définir où sont les données pour le pivotcache 
With Worksheets(RgT) 
     Adr = .Name & "!" & .Range("F7:O" & _ 
        .Range("O65536").End(xlUp).Row).Address 
         
         
    'Adr = .Name & "!" & .Range("F7:O" & .Range("O65536").End(xlUp).Row).Address 
'... 
'..., SourceData:=Range(Adr)) 
'Écrivez plutôt : 
'Code VBA: 
'Set MaPlageSource = .Range("F7:O" & .Range("O65536").End(xlUp).Row) 
'... 
'..., SourceData:=MaPlageSource) 

     
         
End With 

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _ 
        Adr).CreatePivotTable TableDestination:= _ 
        "'" & RgT & "TCD'!R3C1", TableName:= _ 
        RgT, DefaultVersion:=xlPivotTableVersion10 
         
Sheets(RgT & "TCD").Select 
    ActiveSheet.PivotTables(RgT).AddFields RowFields:= _ 
        Array("Période", "Date Livraison", "RCT") 
    ActiveSheet.PivotTables(RgT).PivotFields("Impl."). _ 
        Orientation = xlDataField 
    ActiveWorkbook.ShowPivotTableFieldList = True 
     
ActiveSheet.PivotTables(RgT).PivotFields("RCT"). _ 
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _ 
        False, False) 
    ActiveSheet.PivotTables(RgT).PivotFields("Période"). _ 
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _ 
        False, False) 
    ActiveSheet.PivotTables(RgT).PivotFields( _ 
        "Date Livraison").Subtotals = Array(False, False, False, False, False, False, False, _ 
        False, False, False, False, False) 
    ActiveSheet.PivotTables(RgT).AddFields RowFields:= _ 
        Array("Période", "Date Livraison", "RCT") 

     
    ActiveWorkbook.ShowPivotTableFieldList = False 
      
        
Next C 
End Sub

Effectuer des contrôles

2 réponses

Discussions similaires

Newsletters