從符合條件的行中將選定列複製到另一個表格的VBA代碼

Question

我剛剛開始使用Excel的VBA代碼，因此很抱歉，如果這看起來很基本。我想執行以下操作...

檢查名爲「索引」的紙張的J列（J5到J500）是否存在值「Y」。這是我的情況。 然後，我只想複製列C到我只有任何行符合條件的現有工作表和單元格在不同的位置，即如果索引值C3到I3被複制我想將它們粘貼到A5對於我所在活動工作表的G5，請參閱Sheet2。

如果索引表發生變化，我希望自動複製數據，如果可能的話。如果將新數據添加到索引，它如何工作？

經過大量的搜索後，我發現this。從這個問題我稍微改變了代碼，以適應我的要求，這將滿足條件的整個行復制到我運行宏從一個表，但我很難爲如何選擇某些列只。

Sub CopyRowsAcross() 

Dim i As Integer 
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Index") 
Dim ws2 As Worksheet: Set ws2 = ActiveSheet 

For i = 2 To ws1.Range("B65536").End(xlUp).Row 
If ws1.Cells(i, 2) = "Y" Then ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1) 
Next i 

End Sub 

任何幫助表示讚賞

約翰

編輯：我創建了一個實體模型和其位於https://docs.google.com/file/d/0B0RttRif9NI0TGl0N1BZQWZfaFk/edit?usp=sharing

不需要A和B柱複印的情況 - 要麼是列J - 多數民衆贊成我正在使用檢查的條件。

感謝您的所有幫助。

Answer 1

下面是更優雅的解決方案，更類似於我原來的帖子。唯一的區別是單元格引用符合正確的表單。

Sub try3() 
Dim i, x As Long 
Dim Y as String 
Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Index") 
Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") 'active sheet can get you into trouble 

x = 5 
Y = "Y" 
For i = 2 To 500: 
    If ws1.Cells(i, 10) = Y Then 
     Range(ws2.Cells(x, 1), ws2.Cells(x, 7)).Value = Range(ws1.Cells(i, 3), ws1.Cells(i, 9)).Value 
     x = x + 1 
    End If 
Next i 
End Sub 

Answer 2

這是借用一些舊的代碼。在此要檢查的最後一排使用，如果你知道你只想要去到500，你可以只使用整數

Sub try2()

Dim i, Y, x As Long 'you didn't mention what Y was, so it could also be a string. 
    Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Index") 
    Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") 'active sheet can get you into trouble 
    Dim Ary1 As Range 
    Dim ary2 As Range 


    x = 5 
    Y = "Y" 'for the sake of argument 
     'For i = 2 To ws1.Range("B65536").End(xlUp).Row This is if you are looking for the last row in MsOf2003 or earlier. If you know that you are only looking to row 500, then hard code the intiger. 
    For i = 2 To 500: 
     'If ws1.Cells(i, 2) = "Y" You mentioned you were interested in column J, so we need to change the 2 to 10 (Column B to Column J) 
     If ws1.Cells(i, 10) = Y Then 
      ws1.Activate 
      Set Ary1 = Range(Cells(i, 3), Cells(i, 9)) 
      ws2.Activate 
      Set ary2 = Range(Cells(x, 1), Cells(x, 7)) 'avoid copying all together you don't need it 
      ary2.Value = Ary1.Value 
      x = x + 1 
     End If 
    Next i 
    End Sub 

我在手機上寫這不編譯器，所以在那裏可能有語法錯誤，這應該被看作僞VBA代碼。我可以稍後檢查一下，看看你是否有效。如果你不想讓它們被覆蓋，你將不得不注意你放置的位置。