VBA - Loop Copier-coller jusqu'à la premiere ligne vide

Bonjour à tous,

J'ai une feuille contenant des tableaux qui sont tous formatés de façon identique. J'aimerais consolider toutes ces données. Pour cela il me faut copier les valeurs de certaines cellules en dernière colonne tant que les données de la colonne de gauche sont non vides (voir exemple en pièce jointe + bas de page ou je veux coller "T1" et "T2"). Je peux le faire pour un seul tableau mais j'aimerais faire un loop qui me permet de le faire pour plusieurs tableaux rapidement. Auriez-vous une idée? Je pensais à deux solutions que je n'arrive pas à coder proprement.

1) Coller en utilisant la propriété CurrentRegion

2) utiliser if (cells(i,j-1) <> "") then var=T1 ou quelque chose comme ça et faire un loop

Je suis un grand débutant comme vous l'aurez remarqué! Quelqu'un a-t-il une idée?

Merci d'avance!

T1

C1 C2 T1

Data1 Data1 Data1 T1

Data2 Data2 Data2 T1

Data3 Data3 Data3 T1

T2

C1 C2 T2

Data1 Data1 Data1 T2

Data2 Data2 Data2 T2

Data3 Data3 Data3 T2

Un update des pérégrinations du jour. Le code ci-dessous me permet de copier aux bons endroits mais j'ai encore du mal à trouver comment mettre les bonnes valeurs (T1 pour tableau 1 et T2 pour tableau 2). La suite dans une durée indéterminée!

Sub copy()

Dim row As Long, lastrow As Long, lastcol As Long
Dim j As Integer

With ActiveSheet
lastrow = .Range("A1").SpecialCells(xlCellTypeLastCell).row
End With

j = 4

For i = 1 To lastrow
If IsEmpty(Cells(i, j - 1)) = False Then
   Cells(i, j).Value = Range("A1")

'Else: Cells(i, j).ClearContents

End If
Next i

End Sub

Voici le code final. Je le trouve peu alambiqué! Si certain ont des suggestions d'amélioration je suis preneur. Je mettrais "résolu" dans 2 jours si personne ne se déclare .

Sub copy()

Dim lastrow As Long
Dim j, k, l As Integer

'Finds lastrow

With ActiveSheet
lastrow = .Range("A1").SpecialCells(xlCellTypeLastCell).row
'lastcolumn = .Range("A5").SpecialCells(xlCellTypeLastCell).Column
End With

j = 4

For l = 1 To lastrow

If IsEmpty(Cells(l, j - 2)) = True Then
   Cells(l, j) = Cells(l, j - 3)
End If
Next l

For k = 2 To lastrow

If IsEmpty(Cells(k - 1, j)) = False And IsEmpty(Cells(k, j)) = True And IsEmpty(Cells(k, j - 1)) = False Then

   Cells(k, 4).Value = Cells(k - 1, j)

End If

Next k
End Sub

Bonjour, bonjour !

A partir du classeur joint avec les colonnes D & E vides, manipulations - depuis la cellule A1,

CTRL + flèche bas puis copie en colonne D - enregistrées par le Générateur de macros :

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 19/03/2015 par The Noob Simulator
'
    Range("A1").Select
    Selection.End(xlDown).Select
    Selection.Copy
    Range("D4:D7").Select
    ActiveSheet.Paste
End Sub

En conservant l'idée du saut de puce vers le bas, voici une démonstration :

Sub Demo()
Dim Rg As Range
Set Rg = Feuil1.Cells(1)
Application.ScreenUpdating = False

Do
    Set Rg = Rg.End(xlDown):  If Rg.Value = "" Then Exit Do

    With Rg.CurrentRegion.Rows
        If .Columns.Count = 3 Then Rg(2, 4).Resize(.Count - 1).Value = Rg.Value
        Set Rg = Rg(.Count)
    End With
Loop Until Rg.Row = Rows.Count

Set Rg = Nothing
End Sub