XL 2010 VBA - recherche texte avec variable

Fab71

XLDnaute Nouveau
bonjour, je débute en VBA et je sèche vraiment et sollicite donc votre aide ;-)

voilà j'importe un fichier csv sur un onglet "CSV"
dans cet onglet je veux chercher et copier sur un autre onglet "RESULTAT" un ensemble de données.

je sais faire une partie, c'est a dire chercher une valeur fixe : practice 1 result
puis selectionner les valeurs adjacentes
puis les coller sur l'onglet RESULTAT, a la suite d'une ligne vide (avec 3 lignes d'espace)

ma macro :

Sub Macro1()
'
' Macro1 Macro
'

' recherche practice 1 result et active cellule
Sheets("CSV").Select
Cells.Find(What:="practice 1 result", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate

' active la tableau soit equivalent de ctrl A
ActiveCell.CurrentRegion.Select

' copie la selection et va sur onglet RESULTAT et colle emplacement vide suivant + 3 lignes
Selection.Copy
With Sheets("RESULTAT")
ActiveSheet.Paste Destination:=.Range("A" & .Range("A" & Rows.Count).End(xlUp).Row).Offset(3)
Application.CutCopyMode = False
.Activate
End With

End Sub

ce que j'aimerai obtenir c'est une recherche sur "CSV" de chaque "practice N result" ou N varie de 1 à X
et de les copier a la suite sur l'onglet "RESULTAT"

Voilà en vous remerciant par avance, Fabrice

désolé pour le doublon...fausse manip au moment de la creation du compte
 
Dernière édition:

mutzik

XLDnaute Barbatruc
bonjour

for i = 1 to ... valeur finale
Cells.Find(What:="practice "& i &" result", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate

suite du code qui copie dans l'autre feuille ...

next i
 

Fab71

XLDnaute Nouveau
je viens de tester, c'est quasi parfait...mais j'ai une erreur a la fin

Erreur d'exécution '91':
Variable objet ou variable de bloc With non définie

je mets mon vba :

Sub Macro1()
'
' Macro1 Macro
'

' recherche practice 1 result et active cellule


Sheets("csv").Select

For i = 1 To Range("A" & Rows.Count).End(xlUp).Row

Cells.Find(What:="practice " & i & " result", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate

' active la tableau soit equivalent de ctrl A

ActiveCell.CurrentRegion.Select

' copie la selection et va sur onglet chronos et colle emplacement vide suivant + 3 lignes

Selection.Copy
With Sheets("chronos")
ActiveSheet.Paste Destination:=.Range("A" & .Range("A" & Rows.Count).End(xlUp).Row).Offset(3)
Application.CutCopyMode = False
.Activate
End With
Sheets("csv").Select
Next i


End Sub
 

mutzik

XLDnaute Barbatruc
Code:
with Sheets("csv")
    For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row

    .Cells.Find(What:="practice " & i & " result", After:=ActiveCell, LookIn:= _
              xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
              xlNext, MatchCase:=False, SearchFormat:=False).Activate

' active la tableau soit equivalent de ctrl A
' copie la selection et va sur onglet chronos et colle emplacement vide suivant + 3 lignes
           ActiveCell.CurrentRegion.copy
           Sheets("chronos").Paste Destination:=Sheets("chronos").Range("A" & .Range("A" _
          & Rows.Count).End(xlUp).Row).Offset(3)
Next i
end with

Application.CutCopyMode = False

End Sub

sinon joindre un bout du fichier ...
 

Fab71

XLDnaute Nouveau
petite requête de nouveau,
J'essaye dans l'onglet CSV de effacer le contenu de la ligne qui se trouve au dessus d'une cellule particulière, en l’occurrence la cellule contenant "Sector 3"

ce que je reussi a faire (en fouinant sur internet et sans trop comprendre le "if not cells"), c'est effacer la ligne contenant ma requête

' suppression de la ligne supérieure à partir de la ligne 1000 à ligne 1

Dim L As Integer
For L = 1000 To 1 Step -1
If Not Cells(L, 1).Resize(1, 6).Find("Sector 3") Is Nothing Then Rows(L).Clear
Next L
 

Fab71

XLDnaute Nouveau
promis c'est la derniere chose jusqu'a la prochaine que je demande lol,

pour terminer, j'aimerais recuperer dans l'onglet CSV
en recherchant dans la colonne A
chaque sector 1 (recuperer la selection, comme un ctrl+A si on se met sur la cellule) et la copier dans l'onglet secteur
idem sector 2 et 3

ca donnerait ce que j'ai fait manuellement dans l'onglet secteur (j'ai fait sur 3 sector 1,2 et 3)
 

Pièces jointes

  • stats2.xlsm
    79.1 KB · Affichages: 28

Fab71

XLDnaute Nouveau
j'ai fait ceci mais ca ne boucle pas, ca s'arrete au premier sector 1, sector 2 ou sector 3 (je seche sur comment boucler)

Sub Secteur()
'
'
Sheets("csv").Select
Columns("A:A").Select

Selection.Find(What:="Sector 1", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.CurrentRegion.Select

Selection.Copy

With Sheets("secteur")
ActiveSheet.Paste Destination:=.Range("A" & .Range("A" & Rows.Count).End(xlUp).Row).Offset(1)
Application.CutCopyMode = False
.Activate
End With
Sheets("CSV").Select

Columns("A:A").Select

Selection.Find(What:="Sector 2", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.CurrentRegion.Select

Selection.Copy

With Sheets("secteur")
ActiveSheet.Paste Destination:=.Range("F" & .Range("F" & Rows.Count).End(xlUp).Row).Offset(1)
Application.CutCopyMode = False
.Activate
End With
Sheets("CSV").Select

Sheets("csv").Select
Columns("A:A").Select

Selection.Find(What:="Sector 1", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.CurrentRegion.Select

Selection.Copy

With Sheets("secteur")
ActiveSheet.Paste Destination:=.Range("K" & .Range("K" & Rows.Count).End(xlUp).Row).Offset(1)
Application.CutCopyMode = False
.Activate
End With
Sheets("CSV").Select
End Sub
 

Pièces jointes

  • stats2.xlsm
    80.1 KB · Affichages: 31

Fab71

XLDnaute Nouveau
bon voici mon résultat (si ca interesse ceux qui suivent ce fil)

' boucle sector 1 pour copier et coller de csv à secteur

Dim Ligne As Integer

Application.ScreenUpdating = False

lg = 1
Ligne = Sheets("csv").Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row + 1
For S1 = 1 To Ligne
If Sheets("csv").Range("A" & S1) = "Sector 1" Then

Sheets("csv").Select

Range("A" & S1).Select
ActiveCell.CurrentRegion.Select
Selection.Copy
With Sheets("secteur")
ActiveSheet.Paste Destination:=.Range("A" & .Range("A" & Rows.Count).End(xlUp).Row).Offset(2)
Application.CutCopyMode = False
.Activate
End With

End If
Next S1
 

Discussions similaires

Réponses
6
Affichages
330