Copy part of a spreadsheet

[dpaton05]

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?

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

 

[sparky2205]

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.

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

 

[dpaton05]

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]

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]

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]

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

Dropbox - File Deleted - Simplify your life

www.dropbox.com

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]

I worked it out. I just copied the range everytime I ran the code. Thanks anyway

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