Sep 10 2021 01:28 AM
Hi All,
I have the following code to copy the range B:T once column P changes. (only the row the change was on.)
I would then like it to paste within range B5:B44 on a different sheet on the next empty row but currently it only pastes B2:T5 (Starting row is incorrect) and it will keep pasting over those 3 rows only.
Can anyone help me please? I have ten different ranges on the same sheet to paste in the next tab within it's own range but all of them are doing the same starting the paste 3 rows higher and only pasting over the same 3 rows. (Code is the same for each section so only pasted a snippet.)
Thank you in advance
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim copysheet As Worksheet
Dim Pastesheet As Worksheet
Set copysheet = Worksheets("DH Write Offs")
Set Pastesheet = Worksheets("Written Off")
Application.ScreenUpdating = False
If Target.Column = 16 And Target.Row >= 5 And Target.Row <= 44 Then
Set r = Target.Offset(, -14).Resize(, 19)
copysheet.Range(r.Address).Copy
Pastesheet.Range("B5:B44").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
End Sub
Sep 10 2021 03:01 AM
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim s As Long
Dim Pastesheet As Worksheet
If Not Intersect(Range("P5:P44"), Target) Is Nothing Then
Set Pastesheet = Worksheets("Written Off")
s = Pastesheet.Range("B:T").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If s < 4 Then s = 4
For Each r In Intersect(Range("P5:P44"), Target)
s = s + 1
Pastesheet.Range("B" & s).Resize(1, 19).Value = r.Offset(0, -14).Resize(1, 19).Value
Next r
End If
End Sub
Sep 10 2021 03:55 AM
Thank you for the reply but unfortunately it doesn't work
I've attached an example spreadsheet, each section is it's own cost centre (Branch) and must only paste within the corresponding section on the Written Off tab. (All sections are the same size and format across both tabs.)
Sep 10 2021 04:26 AM
SolutionThere was no way I could have guessed this from your first post...
Here is a new version:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim r As Range
Dim s As Long
Dim Pastesheet As Worksheet
Set Pastesheet = Worksheets("Written Off")
For i = 5 To 392 Step 43
If Not Intersect(Range("P" & i).Resize(40), Target) Is Nothing Then
s = Pastesheet.Range("P" & i + 40).End(xlUp).Row
If s < i - 1 Then s = i - 1
For Each r In Intersect(Range("P" & i).Resize(40), Target)
s = s + 1
Pastesheet.Range("B" & s).Resize(1, 19).Value = r.Offset(0, -14).Resize(1, 19).Value
Next r
End If
Next i
End Sub
Sep 10 2021 04:33 AM
Sep 10 2021 04:26 AM
SolutionThere was no way I could have guessed this from your first post...
Here is a new version:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim r As Range
Dim s As Long
Dim Pastesheet As Worksheet
Set Pastesheet = Worksheets("Written Off")
For i = 5 To 392 Step 43
If Not Intersect(Range("P" & i).Resize(40), Target) Is Nothing Then
s = Pastesheet.Range("P" & i + 40).End(xlUp).Row
If s < i - 1 Then s = i - 1
For Each r In Intersect(Range("P" & i).Resize(40), Target)
s = s + 1
Pastesheet.Range("B" & s).Resize(1, 19).Value = r.Offset(0, -14).Resize(1, 19).Value
Next r
End If
Next i
End Sub