Цель: Когда в рабочей таблице RP есть номер, столбец W, т. Е. Не пустой, данные этой конкретной строки необходимо скопировать в следующую пустую строку таблицы Calc Data. Однако данные не в порядке, т. Е. Строка A = / = ACC # Parish для рабочей таблицы RP.
Таким образом, необходимо следовать = если столбец W не пустой, то скопируйте столбец B (строки не пустые), столбец D (строки не пустые), столбец A (строки не пустые) и т. Д. В таблицу Calc Calc в следующей пустой строке, столбцы A - P в зависимости от обстоятельств.
Рабочий лист собирает данные в следующем формате

Рабочий лист с данными, которыми нужно манипулировать

Помогите решить код: Я уже начал свой код, но я застрял на том, как продолжить, или даже если я на правильном пути! Столбцы списка начинают выходить за пределы диапазона, и я не уверен, как заставить его фильтровать только непустые диапазоны или как скопировать столбцы для определенных данных в конечные строки (A - Q) в конкретном порядок!
Dim RPDataTbl As ListObject
Dim parishCol As ListColumn, LossRentcol As ListColumn, parishcodeCol As ListColumn, buildnoCol As ListColumn, insuredassCol As ListColumn, crestaCol As ListColumn, basiscoverCol As ListColumn
Dim copyRng As Range
Set RPDataTbl = Sheets("Risk Partner Data").ListObjects("RPdata")
With RPDataTbl
Set parishCol = .ListColumns("Parish")
Set LossRentcol = .ListColumns("Loss of Income or Rent")
Set parishcodeCol = .ListColumns("Parish Code")
Set crestaCol = .ListColumns("Cresta")
Set basiscoverCol = .ListColumns("Basis of Cover")
.Range.AutoFilter Field:=LossRentcol.Index, Criteria1:= <not blank?>
End With
On Error Resume Next
Set copyRng = parishCol.DataBodyRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not copyRng Is Nothing Then
copyRng.Copy
With Sheets("Calc Data")
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End If
Спасибо всем заранее!