Скопируйте и вставьте в следующую пустую строку и столбец соответственно

Question

Я задавал несколько раз по этому вопросу & все время, мне давали смутный ответ, что не очень помогает. Таким образом, я просто занимаюсь исследованиями самостоятельно и придумал следующий код из моих исследований. Что работает, но точно не дает мне желаемого результата, указанного в прилагаемом изображении. При этом коды вставляют данные из указанных ячеек, но вставляют их в столбец А, который не является желаемым результатом, а скорее вставляют из колонки B вперед для листов DX, DY & DZ. Есть ли способ, которым я могу получить столбец A, чтобы обновить дату самостоятельно по дате, введенной в ячейку S9, которая помечена вместе с данными для листов DX, DY & DZ. Аналогично для листа RAW, то обновление строки 6 с датой, введенной в S9 листа GP Data

Sub Prism2ndStep() 
' 
' Prism2ndStep Macro 
' 
    r = 1 
Sheets("GP Data").Range("S12:S14").Copy 
If Sheets("GP Data").Range("S12") = Sheets("DX").Range("A65536").End(xlUp) _ 
    Then r = 0 
Sheets("DX").Range("A65536").End(xlUp).Offset(r, 0).PasteSpecial _ 
    Paste:=xlPasteValues, Transpose:=True 
Application.CutCopyMode = False 

j = 1 
Sheets("GP Data").Range("T12:T14").Copy 
If Sheets("GP Data").Range("T12") = Sheets("DX").Range("A65536").End(xlUp) _ 
    Then j = 0 
Sheets("DX").Range("A65536").End(xlUp).Offset(j, 0).PasteSpecial _ 
    Paste:=xlPasteValues, Transpose:=True 
Application.CutCopyMode = False 

k = 1 
Sheets("GP Data").Range("U12:U14").Copy 
If Sheets("GP Data").Range("U12") = Sheets("DX").Range("A65536").End(xlUp) _ 
    Then k = 0 
Sheets("DX").Range("A65536").End(xlUp).Offset(k, 0).PasteSpecial _ 
    Paste:=xlPasteValues, Transpose:=True 
Application.CutCopyMode = False 


Dim copySheet As Worksheet 
Dim pasteSheet As Worksheet 

Set copySheet = Worksheets("GP Data") 
Set pasteSheet = Worksheets("RAW") 

copySheet.Range("P12:R14").Copy 
With pasteSheet 
.Cells(7, .Columns.Count).End(xlToLeft).Offset(0, 7).PasteSpecial _ 
    Paste:=xlPasteValues, Operation:=xlNone, _ 
    SkipBlanks:=False, Transpose:=False 

End With 

End Sub 

Answer 1

Попробуйте этот макрос для копирования данных из «GP данных» S12: S14 и вставить его в колонке B: D в DX вкладка. Отредактировано

Sub prism2ndStep() 
    'get date from cell p9 
    strdate = Sheets("GP Data").Range("S9").Value 
    arrData = Sheets("GP Data").Range("S12:S14").Value 
    Set rngwrite = Nothing 
    Set rngwrite = Sheets("DX").Range("A:A").Find(strdate, LookIn:=xlFormulas) 
    Do While rngwrite Is Nothing 
     With Sheets("DX").Range("A60000") 
      .End(xlUp).AutoFill (.End(xlUp).Resize(2)) 
     End With 
     Set rngwrite = Sheets("DX").Range("A:A").Find(CDate(strdate), LookIn:=xlFormulas) 
    Loop 
    rngwrite.Offset(, 1).Resize(, 3).Value = Application.Transpose(arrData) 

End Sub 

Sub prism2ndStep2() 
    'get data 
    arrData = Sheets("GP Data").Range("P12:R14").Value 
    'find get the first non-blank column in row 7 from right to left 
    Set rngwrite = Sheets("RAW").Range("IV7").End(xlToLeft).Offset(, 1) 
    'paste data 
    rngwrite.Resize(3, 3).Value = arrData 
    'drag dates across row 7 
    rngwrite.Offset(-1).Value = rngwrite.Offset(-1, -3).Value + 1 
End Sub