VBA Help Solve Code для копирования, фильтрации, вставки в строки в зависимости от условия - PullRequest
0 голосов
/ 09 января 2019

Цель: Когда в рабочей таблице RP есть номер, столбец W, т. Е. Не пустой, данные этой конкретной строки необходимо скопировать в следующую пустую строку таблицы Calc Data. Однако данные не в порядке, т. Е. Строка A = / = ACC # Parish для рабочей таблицы RP.

Таким образом, необходимо следовать = если столбец W не пустой, то скопируйте столбец B (строки не пустые), столбец D (строки не пустые), столбец A (строки не пустые) и т. Д. В таблицу Calc Calc в следующей пустой строке, столбцы A - P в зависимости от обстоятельств.

Рабочий лист собирает данные в следующем формате Calc Data, copying into last empty row here

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

Помогите решить код: Я уже начал свой код, но я застрял на том, как продолжить, или даже если я на правильном пути! Столбцы списка начинают выходить за пределы диапазона, и я не уверен, как заставить его фильтровать только непустые диапазоны или как скопировать столбцы для определенных данных в конечные строки (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

Спасибо всем заранее!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...