Excel VBA - 如果行值複製其他工作表

Question

嘿，

我需要Excel幫助。爲了更好地保持原狀，附圖。 基本上我需要excel逐行瀏覽並使用設置值複製所有行（請參見圖片）。

• 邏輯：
• 如果COL1值 「1」 拷貝（永遠）'
• 櫃面COL3值 「X」 副本也行下方（值= 2）
• 如果COL3不是「X 「複製和跳到下一COL1 = 2
• 如果COL3不是 」X「 拷貝，然後跳到下一個COL1 = 1
• 如果COL1值 」1「 拷貝（永遠）
• 櫃面COL3值不是 」X「 跳過到下一個COL1 = 1

等

編輯：ATTACHED EXCEL FILE WITH EXAMPLE OUTPUT

Excel - Picture

If Sheets(1).Cells(i, 1).Value = 1 Then 
    //*copy entire row and skip everything until Sheets(1).Cells(i, 1).Value = 1*// 
    else if Sheets(1).Cells(i, 1).Value = 1 And Sheets(1).Cells(i, 3).Value = "x" Then 
    *copy entire row and continue loop* 

    If Sheets(1).Cells(i, 1).Value = 2 Then 
    //*copy entire row and skip everything until Sheets(1).Cells(i, 1).Value = 2 or higer*// 
    else if Sheets(1).Cells(i, 1).Value = 2 And Sheets(1).Cells(i, 3).Value = "x" Then 
    *copy entire row and continue loop* 

    If Sheets(1).Cells(i, 1).Value = 3 Then 
    //*copy entire row and skip everything until Sheets(1).Cells(i, 1).Value = 3 or higher*// 
    else if Sheets(1).Cells(i, 1).Value = 3 And Sheets(1).Cells(i, 3).Value = "x" Then 
    *copy entire row and continue loop* 


    If Sheets(1).Cells(i, 1).Value = 4 Then 
    //*copy entire row and skip everything until Sheets(1).Cells(i, 1).Value = 4 or higher*// 
    else if Sheets(1).Cells(i, 1).Value = 4 And Sheets(1).Cells(i, 3).Value = "x" Then 
    *copy entire row and continue loop* 

Answer 1

我已經修改的代碼，現在從列其拷貝數據A： E，在單元格（i + 1，5）或單元格（counter_rows，5）中添加更多列更改的位置，並添加不同的列號。

與數據行被存儲在數組中，以加快的代碼，並使其更緊湊。你

也應該把這個子程序在VBA模塊。不要向表格添加代碼。

Sub copy_rows_to_sheet2() 
Dim nb_rows As Integer 
Dim counter_rows As Integer 
Application.ScreenUpdating = False 'speed up code 
nb_rows = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row 'count the number of rows with data on sheet(1) 

counter_rows = 2 'the first row on sheet(2) where we start copying data from 


Dim Arr() As Variant ' declare an unallocated array, stores data from range on the sheets (any number of rows and columns) 

For i = 2 To nb_rows 
     Sheets(1).Select 'to add data to array, first select the sheet1 
     If Sheets(1).Cells(i, 1).Value = 1 Or Sheets(1).Cells(i, 1).Value = 2 Then 
      If Sheets(1).Cells(i, 3).Value = "x" Then 'we copy 2 rows when we have x in col 3 
      Arr = Range(Cells(i, 1), Cells(i + 1, 5)).Value 'copy all values from row i and next row counter_rows and columns (A to E=5) 
      Sheets(2).Select 'before the array is pasted to sheet2 first it needs to be selected 
      Range(Cells(counter_rows, 1), Cells(counter_rows + 1, 5)).Value = Arr 
       counter_rows = counter_rows + 2 'counter increments by 2 rows 
      Else 

       Arr = Range(Cells(i, 1), Cells(i, 5)).Value 'copy row i and 5 columns 
       Sheets(2).Select 
       Range(Cells(counter_rows, 1), Cells(counter_rows, 5)).Value = Arr 
        counter_rows = counter_rows + 1 'counter increments by 1 row 
      End If 
     End If 

Next i 

Application.ScreenUpdating = False 'turn back 

End Sub