CODEWITHSUNDEEP
vbaexcel
Jon0311
Jon0311

Reputation: 61

Macro to insert new row and copy a value overwrites the row below

I have written a macro that searches a column for a cell that contains the text "AddCompany" and then for each such cell, inserts a new row into a different sheet and then copies and pastes the value of the adjacent cell (which contains the name of a company) into that new row.

In my copy, I am using made up names in the cells, "Test Company 1" thru "Test Company 4", to test the macro. The macro correctly inserts 4 new rows but only the last company, "Test Company 4" gets pasted. And it gets pasted into the wrong cell, in the row directly below the newly inserted rows.

The final result is that the macro inserts rows 9 thru 12, and pastes "Test Company 4" into row 13 which already contains a name (that I do not wish to change).

What I want the macro to do is to insert a "new" row (just happens to be the 9th row in this case to fit in a larger table) for each "AddCompany" it finds, then paste the company name in the adjacent cell, and repeat until done. The newly inserted rows 9 thru 12 should display each test company in the end.

Any help will be much appreciated.

Thanks, Jon

Sub AddMoreCompanies()

Dim Table As Worksheet:     Set Table = Worksheets(1)
Dim Notes As Worksheet:     Set Notes = Worksheets(2)
Dim Accounts As Worksheet:  Set Accounts = Worksheets(3)
Dim SandI As Worksheet:     Set SandI = Worksheets(4)
Dim Report As Worksheet:    Set Report = Worksheets(5)
Dim Entry As Worksheet:     Set Entry = Worksheets(6)
Dim Issuer As Worksheet:    Set Issuer = Worksheets(7)

Dim Col As Range:           Set Col = Entry.Range("L5:L250")
Dim tCell As Range
Dim Target As Range:        Set Target = Table.Range("D9")

For Each tCell In Col
    If tCell.Value = "AddCompany" Then
            'Inserts new row in the Table
            Table.Rows("9:9").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Table.Rows("10:10").Copy
            Table.Rows("9:9").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
            Table.Range("E10:I10").AutoFill Destination:=Range("E9:I10"), Type:=xlFillDefault
            'copies text into target cell
            Else
        End If
    If tCell.Value = "AddCompany" Then
        Target.Value = tCell.Offset(0, 1).Value
        Else
    End If
    Next tCell
    'Target.Value = tCell.Offset(0, 1).Value  
End Sub

Upvotes: 1

Views: 1018

Answers (1)

A.S.H
A.S.H

Reputation: 29332

What you are missing is that the Target variable, defined as Set Target = Table.Range("D9") will move down and become D10, then D11 (till D13) each time you Insert a new row above it.

For a quick-fix, try to redefine it before copying the value. By changing

Target.Value = tCell.Offset(0, 1).Value

into

Table.Range("D9").Value = tCell.Offset(0, 1).Value

Upvotes: 2

Related Questions