Перенос данных из рабочего листа в другой с условиями

Question

Я надеюсь, вы могли бы помочь мне.Я пытаюсь скопировать определенные данные на основе нескольких индексов и спецификаций.Я описал свой вопрос ниже:

Привет, я учусь на VBA.Я могу переместить все данные, но не могу выполнить формат обработки.

В настоящее время у меня нет готового кода

Я хочу перенести данные с рабочего листа 1 на рабочий лист 2, рабочий лист 3,рабочий лист 4 на основе условий:

copy cell D VALUE if worksheet 1  column A = "Are" 

(if column B = 2 (open worksheet 2), 
AND 
if column C = "You" paste the multiple values of column D in cells C12 TO C19
if column c = "me" paste the multiple values of column D in cell C20 TO C29

if column B = 3 (open worksheet 3), 
AND
if column C = "You" paste the multiple values of column D in cells C12 TO C19
if column c = "me" paste the multiple values of column D in cell C20 TO C29

if column B = 4 (open worksheet 4))  
AND 
if column C = "You" paste the multiple values of column D in cells C12 TO C19
if column c = "me" paste the multiple values of column D in cell C20 TO C29

Спасибо !!

Answer 1

Разделение на несколько листов

Option Explicit

Sub SplitToMultiWorksheets()

    Const cSheets As String = "Sheet1,Sheet2,Sheet3,Sheet4"
    Const cStr1 As String = "Are"
    Const cStr2 As String = "You"
    Const cStr3 As String = "me"
    Const cFirstR As Long = 1
    Const cCol1 As Variant = "A"
    Const cCol2 As Variant = "B"
    Const cCol3 As Variant = "C"
    Const cCol4 As Variant = "D"
    Const cFirst1 As Long = 12
    Const cFirst2 As Long = 20

    'Const cLast1  As Long = 19
    'Const cLast2 As Long = 29

    Dim vntSheets As Variant
    Dim vnt1(2) As Variant
    Dim vnt2(2) As Variant
    Dim lastR As Long
    Dim i As Long
    Dim wsName As String
    Dim First1 As Long
    Dim First2 As Long


    vntSheets = Split(cSheets, ",")

    For i = 0 To UBound(vnt1)
        vnt1(i) = cFirst1 - 1
        vnt2(i) = cFirst2 - 1
    Next

    With ThisWorkbook.Worksheets(vntSheets(0))
        lastR = .Cells(.Rows.Count, cCol1).End(xlUp).Row
        For i = cFirstR To lastR
            If .Cells(i, cCol1) = cStr1 Then
                wsName = vntSheets(.Cells(i, cCol2) - 1)
                Select Case .Cells(i, cCol3)
                    Case cStr2
                        First1 = vnt1(.Cells(i, cCol2) - 2) + 1
                        vnt1(.Cells(i, cCol2) - 2) = First1
                        .Parent.Worksheets(wsName).Cells(First1, cCol3) _
                                = .Cells(i, cCol4)
                    Case cStr3
                        First2 = vnt2(.Cells(i, cCol2) - 2) + 1
                        vnt2(.Cells(i, cCol2) - 2) = First2
                        .Parent.Worksheets(wsName).Cells(First2, cCol3) _
                                = .Cells(i, cCol4)
                End Select
            End If
        Next
    End With

End Sub