Microsoft 365 VBA Compter 2 lignes après la fin d'un tableau dont on a le nom

bluesky12000 · 7 Février 2022

Bonsoir à tous,

Avec du VBA j'insère dans une feuille des tableaux via des connexions Power query.
Chaque tableau correspond à un 1 jour et s'appelle Jour" & i & "_client.
Le nombre de jours est variable et la taille des tableaux est elle aussi variable.
Je peux donc avoir dans un document 2 tableaux et dans un autre 8 tableaux.
Je souhaiterais pouvoir insérer automatiquement un texte entre chaque tableau. Ce texte est lié à des informations situées dans un autre onglet.

Si tous mes tableaux sont vides, tout va bien puisque j'ai indiqué une position fixe
Voici un exemple qui fonctionne pour ajouter mon titre :

Code:

If ws1.Range("F26").Value <> "" Then ws2.Range("D11").Formula = "=Projet!F26"
If ws1.Range("F27").Value <> "" Then ws2.Range("D16").Formula = "=Projet!F27"
If ws1.Range("F28").Value <> "" Then ws2.Range("D21").Formula = "=Projet!F28"
If ws1.Range("F29").Value <> "" Then ws2.Range("D26").Formula = "=Projet!F29"
If ws1.Range("F30").Value <> "" Then ws2.Range("D31").Formula = "=Projet!F30"
If ws1.Range("F31").Value <> "" Then ws2.Range("D36").Formula = "=Projet!F31"
If ws1.Range("F32").Value <> "" Then ws2.Range("D41").Formula = "=Projet!F32"
If ws1.Range("F33").Value <> "" Then ws2.Range("D46").Formula = "=Projet!F33"

Note : l'écart entre D11 et D16 est de 5 ce qui correspond à 2 lignes d'un tableau vide et aux 3 lignes d'écart entre chaque tableau

Problème :
Si j'ajoute les tableaux alors qu'ils contiennent déjà des données (ce qui arrive tout le temps), alors l'emplacement des titres n'est plus le bon. Je perds donc toute flexibilité d'utilisation.

J'arrive à espacer mes tableaux de 3 lignes grâce à myLastRow + 4

VB:

Sub Creer_Cotation_Client2()

Dim i, ws1, ws2 As Worksheet
Set ws1 = Worksheets("Projet")
Set ws2 = Worksheets("Cotation Client")

Dim myLastRow As Long
 
myLastRow = ws2.Range("D500").End(xlUp).Row

'B28 est le nombre de jour dans l'onglet projet

For i = 1 To ws1.Range("B28")
 
With ws2.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Jour" & i & "_client;Extended Properties=""""" _
        , Destination:=Range("B" & myLastRow + 4)).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Jour" & i & "_client]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Jour" & i & "_client"
        .Refresh BackgroundQuery:=False
    End With
 
myLastRow = ws2.Range("B500").End(xlUp).Row

Next i

End Sub

Si les tableaux sont déjà remplis et de taille variable, comment puis-je insérer mes titres sur la 2e ligne qui sépare chaque tableau en utilisation la même logique que mylastrow, mais en faisant référence au nom du tableau?

Edit : J'ai réussi à résoudre mon problème.

Code:

Sub Titres()

Dim i, ws1, ws2 As Worksheet
Set ws1 = Worksheets("Projet")
Set ws2 = Worksheets("Cotation Client")

Dim myLastTableRow As Long
Dim Tableau As ListObject

' B28 est le nombre de jour dans l'onglet projet
For i = 1 To ws1.Range("B28")

Set Tableau = ws2.ListObjects("Jour" & i & "_client")

myLastTableRow = Tableau.Range.rows(Tableau.Range.rows.Count).Row
If ws1.Range("F26").Value <> "" Then ws2.Range("D11").Value = ws1.Range("F26").Value
If ws1.Range("F" & i + 25).Value <> "" Then ws2.Range("D" & myLastTableRow + 2).Value = ws1.Range("F" & i + 26).Value

Next i
End Sub

J'espère avoir été clair

Merci et bonne soirée à tous,

yal · 8 Février 2022

Bonjour si j'ai bien compris la question, voici une piste

VB:

Sub test01()
  Dim numlig As Integer
 
  numlig = Range("Tableau2").Rows(1).Row
  Range("B" & numlig - 3) = "Titre Tableau2"
  numlig = Range("Tableau2").Rows(Range("Tableau2").Rows.Count).Row
  Range("B" & numlig + 2) = "Titre Tableau3"
 
End Sub

bluesky12000 · 8 Février 2022

yal à dit:

Bonjour si j'ai bien compris la question, voici une piste

VB:

Sub test01()
  Dim numlig As Integer
 
  numlig = Range("Tableau2").Rows(1).Row
  Range("B" & numlig - 3) = "Titre Tableau2"
  numlig = Range("Tableau2").Rows(Range("Tableau2").Rows.Count).Row
  Range("B" & numlig + 2) = "Titre Tableau3"
 
End Sub

Merci Yal, c'est encore plus simple

Microsoft 365 VBA Compter 2 lignes après la fin d'un tableau dont on a le nom

bluesky12000

XLDnaute Junior

yal

XLDnaute Occasionnel

Pièces jointes

bluesky12000

XLDnaute Junior

Discussions similaires