Macro - 2 Sheets - Find/Insert/Copy/Paste
 

Hi Tom,
You did such a wonderful job helping me last time that I was hoping you
might be able to help me take this macro another step or 2.

After the value from Sheet2 cell B2 has been populated into the inserted row
I'd like to copy the values in columns A and C from the row immediately above
down into columns A and C of the same newly inserted row.

Again, any help is greatly appreciated!!


Sub FindInsertRowPaste()

Dim rngFound As Range
Dim strFirstAddress As String
Dim strFindString As String

strFindString = Worksheets("Sheet2").Range("B1").Value

With ActiveSheet.Range("B:B") 'must be on sheet1 when running macro!!!!

Set rngFound = .Find(What:=strFindString, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not rngFound Is Nothing Then
'Application.Calculation = xlCalculationManual
strFirstAddress = rngFound.Address
Do
rngFound.Offset(1, 0).EntireRow.Insert
rngFound.Offset(1, 0).Value = Worksheets("Sheet2") _
..Range("B2").Value
Set rngFound = .FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
'Application.Calculation = xlCalculationAutomatic
End If
End With
End Sub



"Tom Ogilvy" wrote:

Sub TestFindInsertRowPaste()


Dim rngFound As Range
Dim strFirstAddress As String
Dim strFindString As String

strFindString = Worksheets("Sheet2").Range("B2").Value

With ActiveSheet.Range("B:B")
Set rngFound = .Find(What:=strFindString, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not rngFound Is Nothing Then
'Application.Calculation = xlCalculationManual
strFirstAddress = rngFound.Address
Do
rngFound.Offset(1, 0).EntireRow.Insert
rngFound.Offset(1,0).Value = Worksheets("Sheet2") _
.Range("B3").Value
Set rngFound = .FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
'Application.Calculation = xlCalculationAutomatic
End If
End With
End Sub

--
Regards,
Tom Ogilvy

"shorticake" wrote:

I have 2 sheets in my workbook, named Sheet1 and Sheet2. I'd like to change
the code below so that instead of hardcoding "200611" the code would use what
is in Sheet2 cell B2 as the string to find in Sheet1. Then after it inserts
the row, I'd like to have it use what is in Sheet2 cell B3 to paste into
column B of each of the newly inserted rows.

Any help is greatly appreciated!


Sub TestFindInsertRowPaste()


Dim rngFound As Range
Dim strFirstAddress As String
Dim strFindString As String

strFindString = "200611"

With ActiveSheet.Range("B:B")
Set rngFound = .Find(What:=strFindString, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not rngFound Is Nothing Then
'Application.Calculation = xlCalculationManual
strFirstAddress = rngFound.Address
Do
rngFound.Offset(1, 0).EntireRow.Insert
Set rngFound = .FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
'Application.Calculation = xlCalculationAutomatic
End If
End With
End Sub