根据条件复制和粘贴范围

在过去的几天里，我很努力地写macros，可以做以下事情：1.复制一张表格中的特定单元格（是否复制取决于条件）2.将它们放入指定的表格（名称由一个公式分割）到指定的单元格中（它们也由公式指定）。

不幸的是我不能粘贴图像，所以我会尝试通过粘贴代码草图来解释我想要做的事情。 如果这个模糊请让我知道。

Sub The_One() ' For Each c In Worksheets("fsr").Range("O:O") If c.Value = "p" Then 'Now I do not know how to make Excel copy the cells from current row from columns E,F,G,H 'Now I would like to add cells into the worksheet which name is sepcified by the formula from column P. 'Inserted cells should be added into a row given by the formula in column Q. 'I imagine it like that: Sheets("group1").Select 'This "group1" cannot be simply tiped into the code, it should be taken from Column P in worksheet("fsr") Range("A3:I3").Select 'As above, the range should be specified more like that: 'Range("A[row number given by a formula in column Q in Worksheet("fsr")]:I[the same number as before] Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'Now I would like to copy four cells from Worksheet("fsr") they are in the same row as the current cell from above For Each 'I imagine it somehow like that: Range("E'Here I dont know how to define the row number':H'The same problem'").Activate ActiveCell.CurrentRegion.Select 'Is CurrentRegion suitable? Selection.Copy Worksheets("group1").Select 'But this worksheet should be the one that is given by a formula in column P in Worksheet("fsr") Range("E'Here I dont know how to define the row number':F'The same problem'").Activate ActiveSheet.Paste 'But I dont want to paste it anywhere. It sholud be pasted into the worksheet given by the formula from column P, 'into the row given by the formula from column Q, into the columns C,D,E,F. So: 'So when the For Each starts to go trough Range("O:O") in Worksheet("fsr") it notices that there is "p" so it should: 'copy cells E2:H2 (because this "p" is in the second row) and paste it in the Worksheet("group1") (because this is what 'we find in cell P2 into the cells C3:F3 (row 3 because "3" is what we find in Q2) End If Next c End Sub 

我是新的Stackoverflow，所以我将不胜感激所有评论关注我的行为在这里。 我希望你会find第二个帮助我，我真的需要你的帮助。 与最好的问候Artur Rutkowski

Answer 1

 For Each c In Worksheets("fsr").Range("O:O") 'This will slow your macro as Excel will search all 1048576 rows 'I suggest you define the range of data in another sheet 

起始行| 1
结束行| 三十

 Sub The_One() startrow = Worksheets("Sheet1").Cells(1,1) endrow = Worksheets("Sheet1").Cells(2,1) For x = startrow to endrow If Cells(x,"O").Value = "p" Then Range("E" & x, "H" & x).Copy Worksheets(Cells(x, "P").Value).Cells(Cells(x, "Q").Value, "C").PasteSpecial xlPasteAll End If Next End Sub