將Sheet1的第2行中的黃色單元格依次複製到Sheet2

我想要搜索工作表「In Motion」的第2行中的單元格。如果單元格突出顯示黃色，我想複製整個列並將其粘貼到工作表「儀表板」。我想重複這個操作來找到「In Motion」第2行中的每個黃色單元格。我也希望將這些列按順序粘貼到「儀表板」上。將Sheet1的第2行中的黃色單元格依次複製到Sheet2

我已經部分從運行宏中創建的代碼不起作用。它會複製它在「In Motion」中找到的第一個黃色單元格的列，並粘貼到「Dashboard」的A1中。但是，它不通過第2行中的所有單元循環。它只是停止。

此外，我認爲如果循環工作，我的代碼不會有效地將列按順序粘貼到「儀表板」。我想他們都會貼着A1。

對不起noob quesiton。非常感謝幫助！

Sub AutoPopulateNew() 
Dim C As Range 

'Clear Dashboard 
Worksheets("Dashboard").Activate 
Worksheets("DashBoard").Cells.ClearContents 

'Move to In Motion Sheet 
Worksheets("In Motion").Activate 

'Find and copy yellow highlighted cells 
For Each C In Worksheets("In Motion").Rows("2:2") 
    C.Select 
     With Application.FindFormat.Interior.Color = 65535 
     End With 
    Selection.Find(What:="", LookIn:=xlFormulas, LookAt _ 
     :=xlPart, SearchFormat:=True).Activate 
    ActiveCell.EntireColumn.Copy _ 
     Destination:=Worksheets("Dashboard").Range("A1") 
    Next C 

Worksheets("Dashboard").Activate 

End Sub

來源

2016-12-06 Jaron Weston

查找'FindNext' https://msdn.microsoft.com/en-us/library/office/ff196143.aspx – Chrismas007

謝謝你的提示！ –

您不需要激活工作表來寫入它。我喜歡使用RGB聲明的顏色和（255,255,0）是黃色的。您也可以使用vbYellow。要找出任何顏色的RGB數字，請選擇該單元格，轉到爲背景着色的存儲桶圖標，選擇更多顏色，然後自定義以查看RGB數字。這段代碼可以做到這一點，根據需要進行編輯。

Sub AutoPopulateNew() 
Dim i As Integer 
Dim j As Integer 
Dim count As Integer 
Dim c As Range 

'Clear Dashboard sheet 
Worksheets("DashBoard").Cells.ClearContents 

count = 1 'counts the cells with a matching background color 

'Loop through the cells and check if the background color matches 
For Each cell In Worksheets("In Motion").Rows(2).Cells 
    If cell.Interior.Color = RGB(255, 255, 0) Then 
     Worksheets("Dashboard").Cells(1, count).Value = cell.Value 
     count = count + 1 
    End If 
Next cell 

End Sub

來源

2016-12-06 21:34:52 Ibo

感謝Ibo的幫助！循環工作通過突出顯示的單元格。

對於什麼是值得的，我最終改變了我的方法來複制和粘貼列，根據它們是否在給定行中標記爲「x」。代碼如下，如果它有助於任何人在這裏絆倒。

Sub AutoPopulateX() 
Dim SingleCell As Range 
Dim ListofCells As Range 
Dim i As Integer 

'Clear Dashboard 
    Worksheets("Dashboard").Activate 
    Worksheets("DashBoard").Cells.ClearContents 

'Move to In Motion and Set Range 
    Worksheets("In Motion").Activate 
    Application.Goto Range("a1") 

    Set ListofCells = Worksheets("In Motion").Range("a2:ba2").Cells 

    i = 1 
    Set SingleCell = Worksheets("In Motion").Cells(2, i) 

'Loop: search for xyz and copy paste to Dashboard 
    For Each SingleCell In ListofCells 
     If InStr(1, SingleCell, "x", 1) > 0 Then 
       Range(Cells(3, i), Cells(Rows.count, i)).Copy 
       Worksheets("Dashboard").Paste Destination:=Worksheets("Dashboard").Cells(1, Columns.count).End(xlToLeft).Offset(0, 1) 
     End If 
     Application.Goto Range("a1") 
     i = i + 1 
    Next SingleCell 

'Clean up Dashboard 
    Worksheets("Dashboard").Columns("a").Delete 
    Worksheets("Dashboard").Activate 

End Sub

來源

2016-12-08 23:02:55

將Sheet1的第2行中的黃色單元格依次複製到Sheet2

回答

相關問題