Excel Vba (bouton OnClick)

J'ai cette feuille de calcul contenant des colonnes "code, opération, titre, date, nom, description, statut". Le format est en général.

code:4566, 4899, 4987, 4988, 4989 operation:X,Y,Z,X,Y title:XX,YY,ZZ,RR,XXY date: (the date column is not blank) name:Adam,Edward,Adam,Kris,Chris description: (some rows has data for this column, some are blank) status: active, inactive, closed 

J'essaie de copier des lignes dont la colonne «nom» a la colonne «Adam» ou «Edward» ET «état» avec «active» vers une nouvelle feuille contenant des colonnes «code, titre, date, nom, description, statut». (Je ne veux pas la colonne "opération" dans une nouvelle feuille)

À ce stade, je ne me dérange pas si certaines de mes cellules de description dans les lignes sont vides. Je le veux toujours dans les résultats.

À la fin, les valeurs de retour ne seraient que de 2 lignes: 4566 et 4987
Je pourrais le faire manuellement. Mais je veux essayer si cela peut être fait par vba avec un clic (processus d'automatisation)

Je vous remercie.

P / S: excusez-moi pour ne pas inclure ce que j'ai pour l'instant, voilà

 Options Explicit Sub Button1_Click() Dim myRow As Long 'for finding last row Dim xlast As Integer 'x is the last row Dim sht As Worksheet 'original sheet Dim newsht As Worksheet 'sheet with new data Set sht = ThisWorkbook.Worksheets("Sheet1") Set newsht = ThisWorkbook.Worksheets("Sheet2") myCol = code xlast = sht.Cells(Rows.Count, myCol).End(xlUp).Row 'go through my code column for non-blank For x = 1 To xlast 'from 1st row till last row (tab) If (sheet.name.Cells() = "Adam" OR "Edward") And (sheet.status.Cells() = "active") (tab) Then newsht.Rows.Value(code,title,date,name,description,status) = sheet.Rows().Value(code,title,date,name,description,status) End If Next End Sub 

Il existe quelques problèmes avec votre exemple de code:

Sheet.name.Cells () = "Adam" OU "Edward"

  • Vous devez vérifier une cellule à la fois, plutôt que Cells ()
  • Pour désigner la valeur de la cellule, vous devez vous référer à la propriété Value de la cellule, c'est-à-dire sheet.range (). Value = "Adam"
  • Chaque comparaison (Adam ou Edward) doit être évaluée séparément, c'est-à-dire la plage (). Value = "Adam" OU la plage (). Value = "Edward"

Newsht.Rows.Value (code, titre, date, nom, description, statut)

  • La valeur ne prend pas les gammes nommées comme celle-ci
  • Ce code n'utilise pas l'itérateur i pour indiquer la ligne à laquelle les données doivent être copiées dans la feuille2

Essayez le code ci-dessous. Vous pouvez l'affecter à un bouton si vous le souhaitez. Vous devrez changer la plage dat et newdat en fonction de votre feuille. Le changement principal de votre code est que le décalage est utilisé pour itérer à travers les différentes lignes et colonnes (décalage du coin supérieur gauche du bloc de données) pour vérifier chaque ligne de données. Chaque vérification ou copie est codée explicitement.

 Sub macro2() Set sht = ThisWorkbook.Worksheets("Sheet1") Set newsht = ThisWorkbook.Worksheets("Sheet2") 'Set dat = sht.Range("p9") Set dat = sht.Range("code").Cells(1, 1) Set newdat = newsht.Range("c2") 'initialise counters i = 1 j = 1 'set headings on sheet 2 newdat.Offset(0, 0).Value = dat.Offset(0, 0).Value 'copy code newdat.Offset(0, 1).Value = dat.Offset(0, 2).Value 'copy title newdat.Offset(0, 2).Value = dat.Offset(0, 3).Value 'copy date newdat.Offset(0, 3).Value = dat.Offset(0, 4).Value 'copy name newdat.Offset(0, 4).Value = dat.Offset(0, 5).Value 'copy descr newdat.Offset(0, 5).Value = dat.Offset(0, 6).Value 'copy status Do While dat.Offset(i, 0).Value <> "" 'loop till code data goes blank If ((dat.Offset(i, 4).Value = "Adam" Or dat.Offset(i, 4).Value = "Edward") And dat.Offset(i, 6).Value = "active") Then 'check conditions newdat.Offset(j, 0).Value = dat.Offset(i, 0).Value 'copy code newdat.Offset(j, 1).Value = dat.Offset(i, 2).Value 'copy title newdat.Offset(j, 2).Value = dat.Offset(i, 3).Value 'copy date newdat.Offset(j, 3).Value = dat.Offset(i, 4).Value 'copy name newdat.Offset(j, 4).Value = dat.Offset(i, 5).Value 'copy descr newdat.Offset(j, 5).Value = dat.Offset(i, 6).Value 'copy status j = j + 1 End If i = i + 1 Loop End Sub