开发者

Altering a macro to insert info instead of just copying

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 shee开发者_JAVA技巧t 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.


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.

If c.Value Like "*2188" Then

    LCopyToCol = 1

'--> Sheets("Sheet4").Cells(LCopyToRow, LCopyToCol).EntireRow.Insert shift:=xlDown

    For x = LBound(arrColsToCopy) To UBound(arrColsToCopy)

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:

c.EntireRow.Cells(arrColsToCopy(x)).Copy
Sheets("Sheet4").Cells(LCopyToRow, LCopyToCol).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone


Here's some tips for you:

This code inserts and copies format for me:

    Dim rOrigin As Range, rCopyTo As Range

    Set rCopyTo = Selection
    Set rOrigin = Range("A2")

    rCopyTo.Insert xlShiftToRight, rOrigin.Copy
    Application.CutCopyMode = False


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

myValue = someRange.Text   'reads the output text by the formula but .TEXT is read only so be careful

Another thing you might do is use the Copy function that is built in.

SomeRange.Copy

then go to the sheet you want to paste and do

Activesheet.PasteValues

or

Activesheet.PasteSpecial (use options here to copy formats and so on)
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜