分别复制并粘贴到下一个空行和列

Question

我就这个问题问了很多次&一直以来，我得到的答案都是模糊的，这对我没有太大帮助。因此，我只是自己研究，并从我的研究中得出了以下代码。哪个有效，但并不能完全给我所附图片中所述的预期结果。因此，代码粘贴其指定单元格中的数据，但粘贴到 A 列中，这不是想要的结果，而是从 B 列向前粘贴 sheets DX、DY 和 DZ。还有一种方法可以让 A 列根据在单元格 S9 中输入的日期自行更新日期，该日期与 sheets DX、DY 和 DZ 的数据一起标记。同样，对于 sheet RAW，使用在 sheet GP 数据

的 S9 中输入的日期更新第 6 行

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 Data" S12:S14 复制数据并将其粘贴到 DX 选项卡中的 B:D 列。 已编辑

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

分别复制并粘贴到下一个空行和列

Copy & Paste into next empty row & column respectively

excel

vba

copy-paste