Excel VBA，復制彩色行

Question

我在“ Sheet1”中有一個帶有三列的列表，A（帳號），B（描述）和C（金額）。 基於第一兩列（A和B）的顏色，我想將特定的行復制到“ Sheet2”，並將其粘貼到一個特定的標題下（我有三個標題）。

例

1. Sheet1-單元格A2為“紅色”，B2為“黃色”，在Sheet2的標題“ Inefficiency”下復制/粘貼
2. Sheet1-單元格A3為“藍色”，B3為“無顏色”復制/粘貼在Sheet2的標題“有效”下

---

Account Number  Description  Amount
LP001022        Graduate     3,076.00 
LP001031        Graduate     5,000.00 
LP001035        Graduate     2,340.00 

我已經從該站點獲取了一個代碼，但是我無法完全根據需要配置它。 謝謝您的幫助。

Sub lastrow()
    Dim lastrow As Long
    Dim i As Long, j As Long
    Dim acell As Range

    With Worksheets("Sheet1")
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    MsgBox (lastrow)

    With Worksheets("Sheet3")
        j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With

    For i = 1 To lastrow
        With Worksheets("Sheet1")
            If .Cells(i, 1).Interior.Color = RGB(255, 255, 0) And _
               .Cells(i, 1).Interior.ColorIndex = xlNone Then
                   .Rows(i).Copy 'I have to give destination 
                   j = j + 1
                End If
        End With
    Next i
End Sub

Answer 1

這是將一行從sheet1復制到INSERT並復制到sheet2中的一行的主要說明。 假定您具有所有行號。

' -- to copy a row in sh1 to INSERT into sh2:
  sh2.Rows(irowInefficiency + 1).Insert
  sh1.Rows(irowFrom).Copy sh2.Rows(irowInefficiency + 1)
' -- you have to increment all header rows after this one
  irowEffective = irowEffective + 1

下面將它們放在上下文中：

Sub sub1() ' copy/insert a row
  Dim irowFrom&, irowInefficiency&, irowEffective&
  Dim sh1, sh2 As Worksheet
  Set sh1 = Sheets("sheet1")
  Set sh2 = Sheets("sheet2")
  irowInefficiency = 3 ' where that header is
  irowEffective = 6 ' where that header is
  irowFrom = 5 ' the row to copy
' -- to copy a row in sh1 to INSERT into sh2:
  sh2.Rows(irowInefficiency + 1).Insert ' a blank row
  sh1.Rows(irowFrom).Copy sh2.Rows(irowInefficiency + 1) ' then copy
' -- you have to increment all header rows after this one
  irowEffective = irowEffective + 1 ' because it increases
End Sub