Блог

Вертолет всем,

я хотел бы перенести столбец A-K в другую таблицу, начиная с шестой строки.

он должен перенести столбцы, если я нажму кнопку. Форма пользователя откроется и спросит у меня номер ссылки, который зарегистрирован в Coumn A. Все строки, содержащие выбранный номер ссылки, должны быть перенесены в другую таблицу.

Мой код не работает, потому что он занимает весь столбец. И это не удаляет строки из области копирования.

Область назначения должна быть архивом.

Большое спасибо!

 Sub Archiv()   Dim Zeile As Long Dim ZeileMax As Long Dim Bereich As Range  With Sheets("Protokoll")   'Set Bereich = .Rows(3)    ZeileMax = .Cells(.Rows.Count, 1).End(xlUp).Row    For Zeile = 6 To ZeileMax    If .Cells(Zeile, 1).Value = Userform_boxnumber.Value Then  'Set Bereich = Union(Bereich, .Rows(Zeile))    'Range(Cells(ilastRow, 1), Cells(ilastRow, 11)).Select    End If  Next Zeile  Bereich.Copy Destination:=Sheets("Archiv").Range("A3")  End With  End Sub  

Использование Union для сбора совпадающих строк-хорошая идея. Одна из проблем Union заключается в том, что ни один из диапазонов не разрешен Nothing , или это вызывает ошибку. Таким образом, первая строка, добавленная в диапазон, должна быть сделана без использования Union . Вот почему я использую If Else оператор для обработки первой совпадающей строки.

Я использую .Resize для обрезки диапазонов от полной строки до столбцов A-K.

Наконец, я использую .Delete для очистки области копирования перед размещением новых данных в «Архив». Вы также можете использовать .ClearContents или = "" , все они достигают одной и той же общей цели.

 Sub Archiv()    Dim Zeile As Long  Dim ZeileMax As Long  Dim Bereich As Range    With Sheets("Protokoll")    ZeileMax = .Cells(.Rows.Count, 1).End(xlUp).Row    For Zeile = 6 To ZeileMax  If .Cells(Zeile, 1).Value = Userform_boxnumber.Value Then  If Bereich Is Nothing Then  Set Bereich = .Rows(Zeile).Resize(1, 11)  Else  Set Bereich = Union(Bereich, .Rows(Zeile).Resize(1, 11))  End If  End If  Next    End With   With Sheets("Archiv")  'Clearing the Archiv Copy area  ZeileMax = .Cells(.Rows.Count, 1).End(xlUp).Row  If ZeileMax gt; 6 Then .Range(.Cells(6, 1), .Cells(ZeileMax, 11)).Delete Shift:=xlShiftUp   If Not Bereich Is Nothing Then Bereich.Copy Destination:=.Range("A6")  End With End Sub