更改宏以插入信息而不仅仅是复制
Sub test4()
Dim LCopyToRow As Long
Dim LCopyToCol As Long
Dim arrColsToCopy
Dim c As Range, x As Integer
On Error GoTo Err_Execute
arrColsToCopy = Array(1, 25, 3) 'which columns to copy ?
Set c = Sheets("MasterList").Range("Y5") 'Start search in Row 5
LCopyToRow = 2 'Start copying data to row 2 in Sheet4
While Len(c.Value) > 0
'If value in column Y ends with "2188", copy to Sheet4
If c.Value Like "*2188" Then
LCopyToCol = 1
For x = LBound(arrColsToCopy) To UBound(arrColsToCopy)
Sheets("Sheet4").Cells(LCopyToRow, LCopyToCol).Value = _
c.EntireRow.Cells(arrColsToCopy(x)).Value
LCopyToCol = LCopyToCol + 1
Next x
LCopyToRow = LCopyToRow + 1 'next row
End If
Set c = c.Offset(1, 0)
Wend
'Position on cell A5
Range("A5").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
这就是我现在用来拉出列并将它们粘贴到适当的顺序中的方法。我希望发生两件事。首先，这个宏只是粘贴信息；我想插入信息行，因为我在列末尾有公式是目标表。只需粘贴，信息就会粘贴到其中包含公式的单元格上。其次，上面的宏没有任何边界；我设置了目标工作表，但粘贴时它会丢失所有边框（即使 MasterSheet 和目标工作表有边框）。也许插入会解决这个问题 - 我不确定。但无论如何我想插入而不是粘贴。
Sub test4()
Dim LCopyToRow As Long
Dim LCopyToCol As Long
Dim arrColsToCopy
Dim c As Range, x As Integer
On Error GoTo Err_Execute
arrColsToCopy = Array(1, 25, 3) 'which columns to copy ?
Set c = Sheets("MasterList").Range("Y5") 'Start search in Row 5
LCopyToRow = 2 'Start copying data to row 2 in Sheet4
While Len(c.Value) > 0
'If value in column Y ends with "2188", copy to Sheet4
If c.Value Like "*2188" Then
LCopyToCol = 1
For x = LBound(arrColsToCopy) To UBound(arrColsToCopy)
Sheets("Sheet4").Cells(LCopyToRow, LCopyToCol).Value = _
c.EntireRow.Cells(arrColsToCopy(x)).Value
LCopyToCol = LCopyToCol + 1
Next x
LCopyToRow = LCopyToRow + 1 'next row
End If
Set c = c.Offset(1, 0)
Wend
'Position on cell A5
Range("A5").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
This is what I'm using now to pull columns and paste them in the appropriat eorder. I would like two things to happen. First, this macro simply pastes the information; I would like to insert the rows of information since i have formulas at the end of columns is the destination sheets. With just pasting, the info will paste over cells that have formulas in them. Second, the macro above doesn't carry over any borders; I have the destination sheet set up but when it pastes it loses all the borders(even though the MasterSheet and the destination sheets are bordered). Maybe inserting will fix that - I'm not sure. But at any rate I would like to insert instead of paste.
如果你对这篇内容有疑问，欢迎到本站社区发帖提问 参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱，如果其他用户或者作者回复了您的评论，将不能在第一时间通知您！
发布评论
评论（3）
如果我理解你的问题，我认为你只需要在粘贴之前在目标表中插入一个新行。
因此，在下面的代码中，我添加了 1 行，在粘贴列的循环之前添加一行。
请告诉我这看起来是否正确，或者我是否误解了您。
更新
要复制格式，请在复制值的行后面添加以下两行：
If I understand your question, I think you just need to insert a new row in your destination sheet before doing your paste.
So, in the code below I added 1 line that adds a row before the loop which pastes the columns.
Let me know if this looks correct, or if I misunderstood you.
UPDATE
To copy formatting, as well, add these 2 lines after the line which copies the values:
这里有一些提示给您：
此代码为我插入和复制格式：
Here's some tips for you:
This code inserts and copies format for me:
从您的代码中，很明显您只是从一张纸中读取值，然后将它们写入另一张纸中。因此，要读取公式生成的值，请使用 .TEXT 而不是 .VALUE
您可以做的另一件事是使用内置的复制功能。
然后转到要粘贴的工作表并执行
或
from your code, it is very clear that you are only READING values from one sheet and then writing them in another sheet. So to read values generated by formulas, use .TEXT instead of .VALUE
Another thing you might do is use the Copy function that is built in.
then go to the sheet you want to paste and do
or