Macro en boucle

Fermé
newparisian - 20 févr. 2014 à 22:15
Le Pingou Messages postés 12225 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 6 décembre 2024 - 21 févr. 2014 à 23:12
Bonjour,

J'ai fait une macro qui me transpose 2 colonnes en Lignes mais en même temps chaque 49 lignes il repart de nouveau sur une nouvelle mais en ne prenant que la deuxiéme colonne

Le soucis ne sachant pas en avance combien de ligne j'aurai je veux la changer pour que ça boucle à chaque fois qu'il rencontre le mot "Interview Date"

Que dois-je changer? et merci beaucoup pour votre aide.

Private Sub Workbook_Open()
Sheets("DataSet1").Select
Range("A1:B49").Select
Selection.Copy
Sheets("Feuil1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("DataSet1").Select
Range("B50:B97").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil1").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("DataSet1").Select
Range("B98:B145").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil1").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("DataSet1").Select
Range("B146:B193").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil1").Select
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("DataSet1").Select
Range("B194:B241").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil1").Select
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("DataSet1").Visible = False
End Sub

Par exemple Tableau de base
Interview Date 2014-02-03
Interviewer GTEST
HR test
First name bbbb
Group Hire date 01/01/2005
Interview Date 2014-02-03
Interviewer GTEST
HR test
First name bbbb
Group Hire date 01/01/2005
Interview Date 2014-02-03
Interviewer GTEST
HR test
First name bbbb
Group Hire date 01/01/2005

Tableau cible
Interview Date Interviewer HR First name Group Hire date ....
2014-02-03 GTEST test bbbbb 01/01/2005 ....
2014-02-03 GTEST test bbbb 01/01/2005 ....
2014-02-03 GTEST test bbbb 01/01/2005 ....


A voir également:

1 réponse

Le Pingou Messages postés 12225 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 6 décembre 2024 1 452
21 févr. 2014 à 23:12
Bonjour,
Essayer avec le code qui suit en admettant les données commence en A1 :B1 et la périodicité « Interview Date « est fixe pour une lecture.
La procédure :
Sub transposedata()
Dim li As Integer, data()
Set shda = Sheets("DataSet1")
Set shf1 = Sheets("Feuil1")
tit = 1
For Each da In shda.Range("A1:a" & shda.Cells(Rows.Count, 1).End(xlUp).Row)
If da = "Interview Date" Then
pas = pas + 1
li = li + 1
c = 0
ReDim Preserve data(0 To 4, 0 To li)
If pas <= tit Then
data(c, li - 1) = da.Value: data(c, li) = da.Offset(0, 1).Value
Else
data(c, li) = da.Offset(0, 1).Value
End If
c = c + 1
ElseIf pas <= tit Then
data(c, li - 1) = da.Value: data(c, li) = da.Offset(0, 1).Value
c = c + 1
Else
data(c, li) = da.Offset(0, 1).Value
c = c + 1
End If
Next da
shf1.Range("a1:e" & Cells(Rows.Count, 1).End(xlUp).Row + 1).ClearContents
shf1.Range("a1:e" & UBound(data, 2) + 1) = Application.Transpose(data)
Set shda = Nothing
Set shf1 = Nothing
End Sub
--
Salutations.
Le Pingou
0