Копирование строк в отдельные листы на основе значения в определенном столбце

Question

Столбец группы в моей таблице содержит значение 1 или 2. Я хочу скопировать строку со значением как 1 в Sheet2 и строки со значениями от 2 до 3 с помощью кнопки. Кроме того, он должен показать сообщение об ошибке, если клетки остаются пустыми или если объект не является ни 1, ни 2.

Ролла нет ширина метра группы

Так как я новичок в кодировании я имею следующий этот подход

1. проверить, если ячейка пуста и генерирует сообщение об ошибке

2. чек, если ячейка содержит значение, отличное от 1 или 2 и генерировать сообщение об ошибке

3. наконец скопировать строку со значениями от 1 до Лист2 и отдыха все в Sheet3

Мне нужна помощь в этом, является эффективным способом. Как я должен сохранить размер файла вниз

enter code here 

Private Sub 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

Создание именованных диапазонов для ваших исходных данных и для строк, после чего вы хотите он должен быть скопирован. В этом примере я использовал «источник», «диапазон1» и «диапазон2». Тогда следующий код копирует исходные данные в соответствующие места:

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», вы можете включить дополнительный код, в который я поставил комментарий, но вам было бы лучше обработать это как проверку данных.