根據特定列中的值將行復制到單獨的工作表中

Question

表中的組列包含值爲1或2。我想要複製行的值爲1到Sheet2和行的值爲2到Sh​​eet3使用按鈕。還它應該顯示錯誤消息，如果細胞被留爲空白，或者如果值既不是1也不2.

輥

由於我新的編碼我具有以下沒有米寬度基這種方法

1. 檢查，如果該細胞是空的，並且如果該單元格包含產生錯誤消息

2. 檢查比1或2，產生錯誤信息

3. 其他值最後一行值1到Sheet2複製和休息都在工作表Sheet 3

我需要做的，這是一種有效的方式幫助。正如我必須保持文件的大小下來

enter code here 

私人小組CommandButton2_Click（）

Dim i As Integer 

p = Sheet1.Range("l1").Value 'no. of filled cells in the range 
Application.DisplayAlerts = False 
Sheet1.Activate 
    ''checking if the range is empty 
    For i = 29 To p + 29 
     If Sheet1.Range("l" & i).Value = "" Then 
     MsgBox ("PLEASE ENTER THE SHRINKAGE GROUP FOR CELL NO. l" & i) 
     Range("L" & i).Activate 
     End 
     End If 
     Next i 
    '' checking if the range contains values other than 1 or 2 

    For i = 29 To p + 29 
     If Sheet1.Range("l" & i).Value <> 1 And Sheet1.Range("l" & i).Value <> 2 Then 
     MsgBox ("SHADE GROUP DOES NOT EXIST FOR CELL NO. l" & i) 

     Range("L" & i).Activate 
     End 
     End If 
     Next i 

' sort based on the group 

Range("a29:L300").Sort _ 
Key1:=Range("l29"), Header:=xlYes 

'count the number of rolls in group 1 
Dim x, y As Long 
Dim a, b As Integer 
x = Range("L" & Rows.Count).End(xlUp).Row 
If x < 29 Then x = 29 
a = Application.WorksheetFunction.CountIf(Range("L12:L" & x), 1) + 28 
Range("M1").Value = a 

' count the number of rolls in group 2 
y = Range("L" & Rows.Count).End(xlUp).Row 
If y < 29 Then y = 29 
b = Application.WorksheetFunction.CountIf(Range("L12:L" & x), 2) 
Range("n1").Value = b 

'' copying groupwise to different sheet 
Sheet1.Range("a29", "l" & a).Copy 
Sheet2.Range("a5").PasteSpecial xlPasteAll 
Sheet2.Range("a5").PasteSpecial xlPasteValuesAndNumberFormats 
'' copying group 2 
Sheet1.Range("a" & a + 1, "l" & a + b).Copy 
Sheet5.Range("a5").PasteSpecial xlPasteAll 
Sheet5.Range("a5").PasteSpecial xlPasteValuesAndNumberFormats 

末次

Answer 1

創建源數據和之後要行命名範圍它被複制。在這個例子中，我使用了「source」，「range1」和「range2」。然後將以下代碼複製源數據到適當的地方：

Sub copyData() 
    Dim source As Range, range1 As Range, range2 As Range 
    Dim r As Range 
    Set source = Range("source") 
    Set range1 = Range("range1") 
    Set range2 = Range("range2") 
    For Each r In source.Rows 
     If r.Cells(1, 4).Value = 1 Then 
      copyRow r, range1 
     ElseIf r.Cells(1, 4).Value = 2 Then 
      copyRow r, range2 
     Else 
      ' handle error here 
     End If 
    Next r 
End Sub 

Sub copyRow(data As Range, targetRange As Range) 
    Set targetRange = targetRange.Resize(targetRange.Rows.Count + 1, targetRange.Columns.Count) 
    For i = 1 To 3 
     targetRange.Cells(targetRange.Rows.Count, i).Value = data.Cells(1, i).Value 
    Next i 
End Sub 

有可能做這涉及數組公式的一個更優雅的方式，但是這應該做的伎倆。

爲了驗證每個單元格只包含「1」或「2」，您可以在其中添加額外的代碼，但是您最好將其作爲數據驗證來處理。