Copy-Pasting row into exact same row on specific other worksheets

[PVANS]

Good morning

I have just finished writing a vba code that inserts a row into a worksheet
and then fills in values based on user input. Now, what I need to occur is
once this process is done, for the row to be copied, and to insert the copied
row into the exact row number on three specific other worksheets.

For example, if the code has created the new row on Sheet1.Row87, for row 87
to be copied and then inserted into row 87 on Sheet2,Sheet3,Sheet4. It can't
just be copied onto row 87 on the others as there may be data in it - it must
use the "insert copied cells" function.

Hope this makes sense, and that someone will be able to help me with it.

Kind regards,

Paul

 

[Mike H]

Hi,

In principle that can be done but we would need to see (at least) that part
of your code that puts the new row on sheet 1 so we know how you are
udentifying the row to ensure we get the same row on other sheets.
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[PVANS]

Hi Mike,

Thanks for the feedback - here is the code that I am using to insert the row:
Dim FindString As String
Dim AccountID As String
Dim ClientID As String
Dim Rng As Range

FindString = "DT"
If Trim(FindString) <> "" Then
With Sheets("MasterDMA").Range("B:B")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xlDown,
CopyOrigin:=xlFormatFromLeftOrAbove
************************************************
*I then have code that enters values into the required cells, but
*Dont want to clutter up this post too much - but if needed, I
will
*supply it -
************************************************
Else
MsgBox "Nothing found"
End If
End With
End If

I now need to replicate that exact row onto 4 identical worksheets in that
exact row.
The Sheet names are DMA, DMA1,DMA2

Can you help me? - As usual thank you so much for taking the time to help
Mike, I cannot tell you how much I appreciate it.

Regards,
Paul

 

[Mike H]

Hi,

Have a look at the code below. I inserted my code between the lines

'************


'************

Note that I didn't understand what this line of your code was doing so i
commented it out

'Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove


Also i dimmed my variable (sh) in the middle of the code which isn't good so
move it to the top. Note also I used your statement

Application.Goto Rng, True

to find out where we are by using Rng.Row

Dim FindString As String
Dim AccountID As String
Dim ClientID As String
Dim Rng As Range

FindString = "DT"
If Trim(FindString) <> "" Then
With Sheets("MasterDMA").Range("B:B")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then

Application.Goto Rng, True
ActiveCell.EntireRow.Select
ActiveCell.EntireRow.Copy 'New line

'Selection.Insert Shift:=xlDown,
CopyOrigin:=xlFormatFromLeftOrAbove

' ************************************************
S = "DMA,DMA1,DMA2"
V = Split(S, ",")
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If Not IsError(Application.Match(CStr(sh.Name), V, 0)) Then
sh.Rows(Rng.Row).EntireRow.Insert
Selection.Copy
End If
Next
' *I then have code that enters values into the required cells,
but
' *Dont want to clutter up this post too much - but if needed,
Iwill
' *supply it -
' ************************************************
Else
MsgBox "Nothing found"
End If
End With
End If
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[PVANS]

Hi Mike,

Brilliant thanks! Works perfectly.

I did change the final line to:
sh.Rows(Rng.Row).EntireRow.Offset(-1,0).Insert

Thank you so much

All the best for the long weekend!

Cheers
Paul

 

[Mike H]

Glad I could help. They're all long weekends for me now I've retired, have a
nice one too
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.