Macro en boucle
newparisian
-
Le Pingou Messages postés 12713 Date d'inscription Statut Contributeur Dernière intervention -
Le Pingou Messages postés 12713 Date d'inscription Statut Contributeur Dernière intervention -
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 ....
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:
- Macro en boucle
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Jitbit macro recorder - Télécharger - Confidentialité
- Xiaomi s'éteint tout seul et se rallume en boucle - Forum Xiaomi
- Excel récupérer couleur cellule sans macro ✓ - Forum Bureautique
1 réponse
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 :
Salutations.
Le Pingou
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
