Copy part of a spreadsheet

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,019
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have a spreadsheet for calculating costs of services for someone.

Row 8 to row 28 contain
  • Dates
  • Times
  • Type of work
  • An area to enter expenses
  • Rows containing various totals
The total rows are in row 20:28. The spreadsheet works at the moment but I want to be able to press a button and copy rows 8:28 and place them below row 28, pushing anything that is below it down, so it is now below the additional rows that have been added. I have worked out code that allows me to copy them once and everything is in the right spot after the first time the copy button is pressed but I want to be able to press it multiple times and if I press it any more than once, everything gets all skewed.

The ability to copy rows is needed as there will be different ratios that apply to the different areas that are copied.

In addition,
  • I have a total field in H29 that sums the totals in H20 to H28
  • H30 is a GST field
  • H31 is a total for this period
  • H32 is a grand total
The total will just be for instance, H31 will be the total for H20:H28 and if it is copied once, that total will now in H54 and I need it to sum H45:H53.


The totals are not working yet but I am just trying to get the formatting working first. Here is the code that makes the range be copied once and everything looks like it should but if I press the button again, I need it to be replicated below it in the same format again. Can someone help me please?

VBA Code:
Sub AddRows()
Dim Total As Range
    With ThisWorkbook.Worksheets("ACA_Quoting")
        .Range("29:31").EntireRow.Insert
        '.Rows(29).Insert Shift:=xlShiftDown 'Inserts a row below the current table to create a buffer zone between the 2 tables.

        .Range("F32:H35").Copy .Range("F51")
        .Range("A8:I28").Copy .Range("A30") 'Pastes a copy of the table below current table between the bottom of the table and the totals
        '.Range("F30:H32").Offset(2, 0).Select 'This is the range of the totals that need to be moved down so the additional table can be pasted in
        '.Range("C7").Insert Shift:=xlDown
        
            .Shapes.Range(Array("cmdAddRatio")).Select
        .Shapes("cmdAddRatio").IncrementTop 340
            .Shapes.Range(Array("cmdGsign")).Select
        .Shapes("cmdGsign").IncrementTop 340
            .Shapes.Range(Array("cmdNoSign")).Select
        .Shapes("cmdNoSign").IncrementTop 340
            .Shapes.Range(Array("cmdSaveToPdf")).Select
        .Shapes("cmdSaveToPdf").IncrementTop 340
            .Shapes.Range(Array("cmdCustomSign")).Select
        .Shapes("cmdCustomSign").IncrementTop 340
            .Shapes.Range(Array("textbox4")).Select
        .Shapes("textbox4").IncrementTop 340
        
        .Range("29:31").EntireRow.Insert
      
    End With
End Sub


Thanks,
Dave
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

sparky2205

Active Member
Joined
Feb 6, 2013
Messages
294
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi,
I have a form, the end of which looks like the attached image. By default the users have space to enter data for 10 samples. This is an arbitrary figure as the actual requirement can be much larger.
I have a macro on the form which allows them to add more samples as required.
I ask the user how many rows they want to add (note: when I say rows I actually mean sample rows which is equal to 4 rows in the spreadsheet)
I create a loop using the input to create however many sample rows the user requires.
The logic I have used is:
Find the last populated row in column A (i.e. A57 in the attachment). This provides a fixed starting point each time.
I then use this to get the position of the last sample rows i.e. 49:52 (Rows(LastRow - 8 & ":" & LastRow - 5).Select in the code). This will always be the same relative to LastRow regardless of how many future rows are added.
I then simply copy these rows and insert them below the last sample rows

The key is finding a fixed point from which to begin each time. It can't be a direct cell reference. That's probably why your code works first time but not subsequently.
I'm including my code below. Forgive all the comments.

VBA Code:
Sub CopyRows()

Dim RowNum As Integer
Dim pw As String
Dim LastRow As Long
Dim i As Integer
Dim iCount As Integer
Dim address As String

    i = 0

'---------------------Check user entry is valid-----------------------------

'Prevent error message appearing on screen
Application.DisplayAlerts = False
' Continue even with error
On Error Resume Next
'Get the number of rows to add from the user
iCount = Application.InputBox("Number of rows to add", Type:=1)
'Clear any errors
Err.Clear
On Error GoTo 0
'Reenable error messages appearing on screen
Application.DisplayAlerts = True

If iCount = False Then
Exit Sub
ElseIf iCount < 1 Then
MsgBox ("Number of rows must be a positive number > 1")
Exit Sub
End If

'--------------------------------------------------------------------------

'Set the password
pw = ""
'Unprotect the form
ActiveSheet.Unprotect Password:=pw
'Prevent screen flicker during execution
Application.ScreenUpdating = False

'Loop to create as many rows as requested
For i = 1 To iCount
'Find the last used row in column A
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
'Assign the cell address of column D of the first newly created row to the variable address
If i = 1 Then
address = "D" & LastRow - 4
End If
'Select the last 4 data entry rows
Rows(LastRow - 8 & ":" & LastRow - 5).Select
'Copy the last 4 data entry rows
Selection.Copy
'Select the row below those 4 rows
Rows(LastRow - 4 & ":" & LastRow - 4).Select
'Insert the 4 copied rows at the bottom of the data entry section
Selection.Insert Shift:=xlDown
'Prevent Excel message about clipboard contents
Application.CutCopyMode = False
'Update the sample number sequentially
ActiveSheet.Range("B" & LastRow - 4).Value = ActiveSheet.Range("B" & LastRow - 8).Value + 1
'Set the value of the newly added data entry cells = n/a (in case the copied cells are populated)
ActiveSheet.Range(address & ":F" & LastRow - 1).Value = "n/a"
Next i

'Place the cursor in the first of the newly created data entry cells
Range(address).Select

'------------------------Reprotect the form-------------------------------
ActiveSheet.Protect Password:=pw, _
AllowFormattingCells:=True, _
AllowFormattingRows:=True, _
AllowFormattingColumns:=True, _
AllowFiltering:=True

'Restore previously changed Excel settings
Application.CutCopyMode = xlCopy
Application.ScreenUpdating = True

End Sub
 

Attachments

  • Form-0956.png
    Form-0956.png
    38.3 KB · Views: 5
Last edited:

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,019
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Thanks for the reply but that wouldn't work. I get the error message of "This won't work because it would move cells in a table on your worksheet". A14:I17 & A20:I28 are tables.

By the way, thank you for the comments as I am still learning to code. It helps with explanations of various bits.
 

sparky2205

Active Member
Joined
Feb 6, 2013
Messages
294
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I'd need to see your spreadsheet to understand the challenges the tables pose.
Visualising it from your description I don't see why it shouldn't be possible with a bit of tweaking to the code. But it may be very different in reality. If you want to post a copy of your spreadsheet to tinyupload.com and send me the link I can have a look over the weekend. I understand this may not always be possible. In that case maybe one of the gurus on here may be able to help you further.
 

jo_hivera

New Member
Joined
May 29, 2020
Messages
28
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

I'm trying to achieve something similar to this, but i only need to copy and paste a template.
I need to copy rows 8:13 of the template sheet (it's a template checklist table) and paste them on the master sheet, starting on row 8.
Everytime i click the button the macro should copy the rows on the template sheet and paste after those 5 rows pasted before on the master sheet. It would start pasting on the row 8 and after that it would paste below row 13 and so forth.
Can you help me out?
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,019
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I know it would be possible by tweaking the code a little but I am not very good at writing VBA and I need help with the code. It is not a table, just a range with numbers and text entered.

Here is a link to the file

I want to run the procedure from a calculation spreadsheet that I cannot upload but the calculation spreadsheet has a copy of sheet2 in the above spreadsheet. I want to use the calculation spreadsheet as a master copy and if I need to update the prices, I will change the range A6:E12 on sheet2 of the calculation spreadsheet.

I have code that copies the calculated rows in the calculation spreadsheet to allocation sheets for storage. The allocation sheets are yearly documents and the file I have uploaded is a copy of one of them. In the code that copies the rows, I want to add code that will compare the range A6:E12 on sheet2 of my calculation sheet to the same range on sheet2 of the allocation sheet that has been opened to have rows copied to it. If it is different, copy the range A6:E12 in sheet2 from the calculation spreadsheet to the same range on sheet2 of the allocation sheet that has been opened.

I hope I have explained that better this time.

Thanks,
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,019
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I worked it out. I just copied the range everytime I ran the code. Thanks anyway :)

VBA Code:
Workbooks(DocYearName).Worksheets("sheet2").Range("A4:E12").Value = Data.Range("A4:E12").Value
 

Watch MrExcel Video

Forum statistics

Threads
1,122,632
Messages
5,597,287
Members
414,134
Latest member
Tiyas44

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top