bomagicmusic
XLDnaute Occasionnel
Bonjour à tous,
J'utilise le code ci-dessous pour copier un tableau en fonction du nombre de lignes. J'aimerai faire de même pour d'autres tableaux et qu'ils viennent se placer en dessous ou à côté du tableau précédent dans la feuille test. L'idéal serait que l'utilisateur puisse choisir les tableaux qu'il veut imprimer en cochant un formulaire, il clique sur actualiser et les tableaux sont sur la feuille récap Test. Quelqu'un a t'il déjà rencontré ce genre de problématique?
Merci beaucoup
Private Sub CommandButton1_Click()
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Application.ScreenUpdating = False
Sheets("Test").Activate ' feuille de destination
Col = "A" ' colonne de la donnée non vide à tester
NumLig = 0
With Sheets("Historique") ' feuille source
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 1 To NbrLig '
If .Cells(Lig, Col).Value <> "" Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Cells(NumLig, 1).Select
ActiveSheet.Paste
End If
Next
End With
Application.ScreenUpdating = True
End Sub
J'utilise le code ci-dessous pour copier un tableau en fonction du nombre de lignes. J'aimerai faire de même pour d'autres tableaux et qu'ils viennent se placer en dessous ou à côté du tableau précédent dans la feuille test. L'idéal serait que l'utilisateur puisse choisir les tableaux qu'il veut imprimer en cochant un formulaire, il clique sur actualiser et les tableaux sont sur la feuille récap Test. Quelqu'un a t'il déjà rencontré ce genre de problématique?
Merci beaucoup
Private Sub CommandButton1_Click()
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Application.ScreenUpdating = False
Sheets("Test").Activate ' feuille de destination
Col = "A" ' colonne de la donnée non vide à tester
NumLig = 0
With Sheets("Historique") ' feuille source
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 1 To NbrLig '
If .Cells(Lig, Col).Value <> "" Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Cells(NumLig, 1).Select
ActiveSheet.Paste
End If
Next
End With
Application.ScreenUpdating = True
End Sub