Excel Vba (przycisk onclick)

Mam ten arkusz roboczy, który zawiera kolumny „kod, operacja, tytuł, data, nazwa, opis, status”. Format jest ogólnie.

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

Próbuję skopiować wiersze, których kolumna „nazwa” ma „Adam” lub „Edward” ORAZ kolumna „status” z „aktywnym” do nowego arkusza zawierającego kod kolumny, tytuł, datę, nazwę, opis, status „tylko”. (Nie chcę kolumny „operacja” w nowym arkuszu)

w tym momencie nie mam nic przeciwko, jeśli niektóre z moich komórek opisu w wierszach są puste. Nadal chcę tego w wynikach.

na koniec zwracane byłyby tylko 2 wiersze: 4566 i 4987
Mógłbym to zrobić ręcznie. Ale chcę spróbować, czy można to zrobić za pomocą jednego kliknięcia (proces automatyzacji)

Dziękuję Ci.

P / S: przepraszam, że nie włączyłem tego, co mam na teraz, oto jest

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

Twój przykładowy kod ma kilka problemów:

sheet.name.Cells () = "Adam" LUB "Edward"

• musisz sprawdzać jedną komórkę naraz, a nie Cells ()
• aby odwołać się do wartości komórki, musisz odwołać się do właściwości wartości komórki, tj. sheet.range (). value = "Adam"
• każde porównanie (Adam lub Edward) musi być ocenione osobno, tj. range (). value = „Adam” OR range (). value = „Edward”

newsht.Rows.Value (kod, tytuł, data, nazwa, opis, status)

• Wartość nie przyjmuje nazwanych zakresów w ten sposób
• ten kod nie używa iteratora i, aby powiedzieć, do którego wiersza skopiować dane w arkuszu 2

Wypróbuj poniższy kod. Możesz przypisać go do przycisku, jeśli chcesz. Trzeba zmienić zakres DAT i newdat do własnych arkusz. Główna zmiana w kodzie polega na tym, że przesunięcie służy do iteracji w różnych wierszach i kolumnach (przesunięcie od lewego górnego rogu bloku danych) w celu sprawdzenia każdej linii danych. Każdy czek lub kopia jest kodowany jawnie.

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