特定の列の値に基づいて行を個別のシートにコピーします。

Question

テーブルのグループ列に値1または2が含まれています。私は値を1とした行をSheet2にコピーし、値が2の行をボタンを使ってsheet3にコピーしたいとします。私は、次のしているコーディングに新しいですので、セルが空白のままにしないか、値がどちらも1本のも2

ロールであれば何メートル幅グループ

ている場合にも、エラーメッセージが表示されるはずですセルが空の場合、このアプローチ

1. チェックし、セルが含まれている場合は、エラーメッセージに

2. チェックを生成1または2と生成エラーメッセージ

3. 以外の値は、最終的にはSheet2の1などの値を持つ行をコピーして、私はこれが効果的な方法であることで助けを必要とシート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 

End Subの

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」のみが含まれていることを検証するには、コメントを追加した場所にコードを追加することができますが、これをデータ検証として扱う方がよいでしょう。