XL 2010 recopie incrémentée + suppression cellules VBA

[babass78]

Bonjour,

J’ai créé 2 macros

- 1 première macro qui :
*onglet Retail10 insère une colonne au début (colonne A), Ajoute le mot Canal (cellule A1), ajoute 10 en A2 et recopie incrémentée jusqu'en bas
*onglet Afh20 insère une colonne au début (colonne A), Ajoute le mot Canal (cellule A1), ajoute 20 en A2 et recopie incrémentée jusqu'en bas
*onglet Export30 insère une colonne au début (colonne A), Ajoute le mot Canal (cellule A1), ajoute 30 en A2 et recopie incrémentée jusqu'en bas

La deuxième macro qui reprend les données de toutes les colonnes des 3 onglets sauf TCD et DATA

Le problème :

Les données des 3 onglets ont des nombres de lignes différentes en fonction des ventes hebdomadaires.

1) Je souhaiterai que le chiffre 10 pour l’AFH se recopie selon le nombre de lignes présentes et idem pour les 2 autres onglets.

2) Lors de la macro qui recopie vers GLOBAL, je souhaiterai qu’elle prenne en compte les titres du tableau d’un des onglets mais sans se répéter au milieu.

3) Je voudrais une macro qui supprime les données de l’onglet GLOBAL après avoir fini

Merci de votre aide

 

[Lone-wolf]

Bonjour babass

Je ne vais pas mettre les mains dans le cambouis, mais il y a une chose qui me fait flipper, pourquoi insèrer une colonne quand elle existe déjà?? Et nettoyer le code, tous ces select ne sont pas bons du tout et sont sans intérêt pour la mise en forme. Un exemple parmi d'autres

Sub Echiquier()
Const nb_cases As Integer = 8    'Echiquier de 8x8 cellules
Dim lig As Integer, col As Integer, nbr As Long    ' => ajout des variables
Dim i As Integer, j As Integer

    Application.ScreenUpdating = False
    Application.Goto Range("c3")

    'Décalage (lignes) à partir de la première cellule = n° de ligne de la cellule active - 1
    lig = ActiveCell.Row - 1

    'Décalage (colonnes) à partir de la première cellule = n° de colonne de la cellule active - 1
    col = ActiveCell.Column - 1

    'Dimensions des cellules
    With Range("b:b, k:k"): .ColumnWidth = 2.8: .RowHeight = 19: End With
    With Range("c3:j10"): .ColumnWidth = 7: .RowHeight = 37.5: .BorderAround Weight:=xlMedium: End With

    'Bordures extérieures
    With Range("b2:k11"): .BorderAround Weight:=xlThick: .Interior.Color = RGB(143, 80, 53): End With

    'Numéros et lettres des cases
    For i = 3 To 10
        nbr = nbr + 1
        Range("k" & i) = nbr
        Range("k" & i).HorizontalAlignment = xlCenter
        Range("k" & i).VerticalAlignment = xlCenter
        Range("k" & i).Font.Bold = True
        Range("k" & i).Font.ColorIndex = 2
    Next
    With Range("c2:j2"): .Value = [{"A", "B", "C", "D", "E", "F", "G", "H"}]: .HorizontalAlignment = xlCenter: _
            .VerticalAlignment = xlCenter: .Font.Bold = True: .Font.ColorIndex = 2: End With

    'Coloriage des cellules
    For l = 1 To nb_cases    'N° ligne
        For c = 1 To nb_cases    'N° colonne
            If (l + c) Mod 2 = 0 Then
                'Cells(n° de ligne + décalage lignes, n° de colonne + décalage colonnes)...
                Cells(l + lig, c + col).Interior.Color = RGB(216, 176, 136)    'Brun clair
            Else
                Cells(l + lig, c + col).Interior.Color = RGB(128, 128, 128)    'Gris clair
            End If
        Next
    Next

    'Mise en place des pièces blanches

    'Les Tourres
    Range("c3") = ChrW(&H2656): Range("j3") = ChrW(&H2656)

    'Les Cavaliers
    Range("d3") = ChrW(&H2658): Range("i3") = ChrW(&H2658)

    'Les Fous
    Range("e3") = ChrW(&H2657): Range("h3") = ChrW(&H2657)

    'La Reine                    'Le Roi
    Range("f3") = ChrW(&H2655): Range("g3") = ChrW(&H2654)

    'Les Pions
    With ActiveSheet.Range("c4:j4"): Range("c4:j4") = ChrW(&H2659): .Font.Name = "Arial": .Font.Size = 28: _
            .Font.Bold = True: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter: .Font.ColorIndex = 2: End With

    With ActiveSheet.Range("c3:j3"): .Font.Name = "Arial": .Font.Size = 28: .Font.Bold = True: _
            .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter: .Font.ColorIndex = 2: End With


    'Mise en place des pièces noires

    'Les Tourres
    Range("c10") = ChrW(&H265C): Range("j10") = ChrW(&H265C)

    'Les Cavaliers
    Range("d10") = ChrW(&H265E): Range("i10") = ChrW(&H265E)

    'Les Fous
    Range("e10") = ChrW(&H265D): Range("h10") = ChrW(&H265D)

    'La Reine                    'Le Roi
    Range("f10") = ChrW(&H265B): Range("g10") = ChrW(&H265A)

    'Les Pions
    With ActiveSheet.Range("c9:j9"): Range("c9:j9") = ChrW(&H265F): .Font.Name = "Arial": .Font.Size = 28: _
            .Font.Bold = True: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter: .Font.ColorIndex = 0: End With

    With ActiveSheet.Range("c10:j10"): .Font.Name = "Arial": .Font.Size = 28: .Font.Bold = True: _
            .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter: .Font.ColorIndex = 0: End With


    Application.Goto Range("m1")
End Sub

 

[Lone-wolf]

Re

En voici un autre et en PJ le classeur exemple

Sub Table()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With Range("d2"): .Value = "VENTES PAR EMPLOYÉS": .Font.Size = 20: .HorizontalAlignment = xlCenter: _
            .VerticalAlignment = xlCenter: .Font.Bold = True: .Font.Color = RGB(192, 0, 0): End With


    With Range("b4", "j4")
        .Value = Array("Commande n°", "Vendeur", "Client", "Date de commande", "Article", _
                       "Quantité", "Prix unitaire", "Remise", "Total")
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
        .Font.ColorIndex = 2
        .Interior.Color = RGB(54, 96, 146)
    End With

    Range("h5:h40").NumberFormat = ("0.-")
    Range("j5:j42").NumberFormat = ("0.00.-")
    Range("i5:i40").NumberFormat = ("0%")
    Range("g5:i40, b5:b40, e5:e40").HorizontalAlignment = xlCenter

    Set rng = Range("b4:j4")
    i = rng.Cells(1, 1).Column - 1
    For Each c In Range("b4:j4")
        c.AutoFilter Field:=c.Column - i, _
                     Visibledropdown:=False
    Next

    Application.Calculation = xlCalculationAutomatic
    
End Sub

 

[babass78]

Merci bien mais je ne comprends pas ce n'est pas la macro pour mon tableau.

je demande à insérer une colonne pour mettre un en tête de colonne et le chiffre qui descende si la cellule de droite est remplie
Merci