I am assuming that you want to copy all over in one operation and not row by row as data is entered in the source data sheet.
It is always good policy to back up your workbook first in case the code does not perform as you expect.
Following guidelines to install the VBA code in case you require them:
- Alt and F11 to open the VBA editor window
- In the VBA editor select menu item Insert -> Module
- Copy the VBA code below and paste into the VBA editor.
- Edit the code where indicated with the comments in the code (Comments will be green when pasted into the VBA editor.
Only 2 lines with comments require editing by you.)
- Close the VBA editor (Cross very top right of VBA editor window)
- Save the workbook as Macro enabled.
- Ensure macros are enabled. See help for how to do this. (Option to "Disable all macros with notification" should be OK.)
- If Developer ribbon not displaying then right click anywhere in one of the ribbons and select "Customize the ribbon". On the right side of the dialog check the box against "Developer" and click OK.
- To run the macro, on the Developer ribbon select Macro icon (towards left in Code block) and then select the macro name (CopyData) and click Run.
- You can also insert a button on the worksheet to run the code and if you require guidelines to do so then please get back to me.
Copy all of the following code into the VBA editor.
Sub CopyData()
Dim wsSource As Worksheet 'Source data worksheet
Dim wsDestin As Worksheet 'Destination worksheet
Dim rngSource As Range 'First column of source data
Dim rngDestin As Range 'Destination range (Includes multiple rows)
Dim lngLastRow As Long 'Last row of data on worksheet (Source and Destination)
Dim lngLastCol As Long 'Last column of data on worksheet (Source and Destination)
Dim rCel As Range 'Each cell of the first column ong Source data
Dim lngMulti As Long 'Number of rows in destination (from column "R")
Set wsSource = Worksheets("Sheet1") 'Edit "Sheet1" to your Source data worksheet
Set wsDestin = Worksheets("Sheet2") 'Edit "Sheet2" to your Destination data worksheet
With wsSource
lngLastRow = LastRowOrCol(True, .Cells) 'Last row with data on Source worksheet
lngLastCol = LastRowOrCol(False, .Cells) 'Last Column with data on Source worksheet
Set rngSource = .Range(.Cells(2, "A"), .Cells(lngLastRow, "A")) 'First column of data on Source Worksheet
End With
For Each rCel In rngSource
lngMulti = rCel.Offset(0, 17).Value 'Number of copies. (Offset 17 from column "A" is column "R")
With wsDestin
lngLastRow = LastRowOrCol(True, .Cells) 'Last used row with data on Destination worksheet
'Next code line sets the entire destination range with mutiple lines as per column "R"
Set rngDestin = .Range(.Cells(lngLastRow + 1, "A"), .Cells(lngLastRow + lngMulti, lngLastCol))
End With
'Copy the source data to the Destination
Range(rCel, rCel.Offset(0, lngLastCol - 1)).Copy Destination:=rngDestin
Next rCel
End Sub
Function LastRowOrCol(bolRowOrCol As Boolean, Optional rng As Range) As Long
'Finds the last used row or column in a worksheet
'First parameter is True for Last Row or False for last Column
'Third parameter is optional
'Must be specified if not ActiveSheet
Dim lngRowCol As Long
Dim rngToFind As Range
If rng Is Nothing Then
Set rng = ActiveSheet.Cells
End If
If bolRowOrCol Then
lngRowCol = xlByRows
Else
lngRowCol = xlByColumns
End If
With rng
Set rngToFind = rng.Find(What:="*", _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=lngRowCol, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
End With
If Not rngToFind Is Nothing Then
If bolRowOrCol Then
LastRowOrCol = rngToFind.Row
Else
LastRowOrCol = rngToFind.Column
End If
End If
End Function