复制并粘贴到下一个空行和列分别
在这个问题上，我总是问了很多次，我给了模糊的答案，这并没有太大的帮助。 因此，我只是自己研究，并从我的研究中提出了以下代码。 哪些工作，但不完全给我所附的图像中所述的预期成果。 从而代码粘贴来自其指定单元格的数据，但是粘贴到不是所需结果的列A中，而是从列B粘贴到表DX，DY和DZ。 还有一种方法，我可以让列A更新date自己根据单元格S9中input的date，该标记与表DX，DY和DZ的数据一起。 同样，对于图纸RAW，更新第6行并在图纸GP数据的S9中inputdate
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 尝试使用此macros从“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