Перенести строки с пустой ячейкой столбца "B" на новый лист "Лист1" - VBA

Формулировка задачи:

Добрый день! Имеется excel файл напечатанного ниже формата: Столбец "A" - ссылка на товар; Столбец "B" - название товара. Напишите пожалуйста макрос который перенесёт те ячейки столбца "A", которые не содержат в столбце "B" информации (то бишь пустые) - перенесёт на новый "Лист1". Пример файла прикрепляю во вложении. P.S. В файле оригинале около 50 тыс. строк из которых около 1-2 тыс. без названия (их необходимо перенести на "Лист1").

Решение задачи: «Перенести строки с пустой ячейкой столбца "B" на новый лист "Лист1"»

textual
                            Листинг программы 
                        

                            Sub test()
Set xl = Worksheets(1) 'Лист1
Set xl1 = Worksheets("Лист3") 'Лист3
Set xl2 = Worksheets("Лист4") 'Лист4
i = 2
Do While i <= xl.Cells(Rows.Count, 1).End(xlUp).Row
    If Trim(xl.Cells(i, 2)) = "" Then
        xl1.Cells(xl1.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = xl.Cells(i, 1)
        xl.Cells(i, 1).EntireRow.Delete
    Else
        xl2.Cells(xl2.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = xl.Cells(i, 1)
        xl2.Cells(xl2.Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) = xl.Cells(i, 2)
        xl.Cells(i, 1).EntireRow.Delete
    End If
Loop
End Sub
                        