Help please...

[jrich1]

I am new to writing macros and need to come up with something to do the following:

Anytime there is text in a cell in column A, insert two rows above the cell with text, copy the range B1:E2 and paste this in the two new rows.

 

[jrich1]

OKay, One more thing...now that I've got those rows inserted, how do I:

For every cell in column A that has data, concatenate that cell with the cell in column B, one row up.

 

[jrich1]

okay - now that i have those rows inserted:
every cell in column A that has data needs to be concatenated with the cell in column B, one row above it. any suggestions on that?

 

[Datsmart]

Sub Insert2Rows2()
Dim LastRow As Long
    LastRow = Cells(Rows.Count, "B").End(xlUp).Row
    For I = LastRow To 3 Step -1
        If Cells(I, "A") <> "" Then
            Range(Cells(I, 1), Cells(I + 1, 1)).EntireRow.Insert
            Range("B1:E2").Copy Cells(I, "B")
            Cells(I + 1, "A").Value = Cells(I + 2, "A").Value & Cells(I + 2, "B").Value
        End If
    Next I
End Sub

 

[jrich1]

Perfect. I appreciate your time.

 

[jrich1]

can this be modified so that it loops through multiple worksheets?

 

[Datsmart]

The revised code will cycle through the two worksheets, (Sheet5 and Sheet6), listed in the Array code:

Sub Insert2Rows()
Dim LastRow As Long
    For Each wks In ThisWorkbook.Worksheets(Array("Sheet5", "Sheet6"))
        With wks
            Sheets(wks.Name).Activate
            LastRow = Cells(Rows.Count, "B").End(xlUp).Row
            For I = LastRow To 3 Step -1
                If Cells(I, "A") <> "" Then
                    Range(Cells(I, 1), Cells(I + 1, 1)).EntireRow.Insert
                    Range("B1:E2").Copy Cells(I, "B")
                    Cells(I + 1, "A").Value = Cells(I + 2, "A").Value & Cells(I + 2, "B").Value
                End If
            Next I
        End With
    Next wks
End Sub

Adjust the worksheet names and/or add other names in the code as needed.

 

[jrich1]

i altered the sheet names however am still getting an error code '9'- subscript out of range.
do i have to 'dim' the wks variable?

not sure if it matters but my sheets are numbers (i.e. "101322", etc.)

 

[jrich1]

I added 'dim wks as sheet' to the code, and looks like that fixed the issue, however, now i'm getting, another error in the Sheets(wks.Name).Activate
code - 'method or data member not found'. Any ideas?

Sub Insert2Rows()
Dim LastRow As Long
Dim wks As Sheets
For Each wks In ThisWorkbook.Worksheets(Array("101322", "101325"))
With wks
Sheets(wks.Name).Activate
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
For I = LastRow To 3 Step -1
If Cells(I, "A") <> "" Then
Range(Cells(I, 1), Cells(I + 1, 1)).EntireRow.insert
Range("B1:E2").Copy Cells(I, "B")
Cells(I + 1, "A").Value = Cells(I + 2, "A").Value & Cells(I + 2, "B").Value
End If
Next I
End With
Next wks
End Sub

 

[JackDanIce]

Try:

Sub Insert2Rows()
 
Dim LastRow As Long, i as Long, j as long

Application.ScreenUpdating = False
For j = 1 to Worksheets.count
  With Sheets(j)
    LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
    LastRow = .Cells(LastRow, "A").End(xlUp).Row
    For i = LastRow To 3 Step -1
        If .Cells(i, "A") <> "" Then
            .Range(Cells(i, 1), Cells(i + 1, 1)).EntireRow.Insert
            .Range("B1:E2").Copy Cells(i, "B")
           .Cells(i + 1, "A") = .Cells(i + 2, "A") & .Cells(i + 2, "B")
           i = .Cells(I, "A").End(xlUp).Row + 1
           If i < 3 Then Exit For
        End If
    Next i
  End With
Next j
Application.ScreenUpdating = True
End Sub

 

[jrich1]

JackDanIce - that one didn't work either. and i didn't get any error message to try to debug it so I don't know how to fix.