CODEWITHSUNDEEP
excelvbacopy-paste
weizer
weizer

Reputation: 1117

How to paste the data in a range where the starting row and column of the range is defined in a cell?

I have two sheets in my excel file:

Input Sheet: Sheet1

enter image description here

Target Sheet: Sheet2

enter image description here

What I want to achieve is to paste the value start from the column that I defined in cell C5 and also start from the row that I defined in cell C6. If the range defined by cell C5 and C6 already have data, then it will find the next empty row based on the column in cell C5 and paste the data in that empty row.

For example in the screenshot above, the starting column & row defined in cell C5 & C6 is B8, so the copied value will be pasted starting from cell B8 until E8. However, if the row already have data, then it will find the next empty row based on column B (which is B9) and paste it there.

I'm not sure how to modified my current script:

Public Sub CopyData()

    Dim InputSheet As Worksheet ' set data input sheet
    Set InputSheet = ThisWorkbook.Worksheets("Sheet1")
    
    Dim InputRange As Range ' define input range
    Set InputRange = InputSheet.Range("G6:J106")
    
    Dim TargetSheet As Worksheet
    Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")
    
    Const TargetStartCol As Long = 2        ' start pasting in this column in target sheet
    Const PrimaryKeyCol As Long = 1         ' this is the unique primary key in the input range (means first column of B6:G6 is primary key)
    
    Dim InsertRow As Long

    InsertRow = TargetSheet.Cells(TargetSheet.Rows.Count, TargetStartCol + PrimaryKeyCol - 1).End(xlUp).Row + 1
  
    ' copy values to target row
    TargetSheet.Cells(InsertRow, TargetStartCol).Resize(ColumnSize:=InputRange.Columns.Count).Value = InputRange.Value

End Sub

Any help or advice will be greatly appreciated!

Testing Scenario 1

enter image description here

Output of Testing Scenario 1

enter image description here

Upvotes: 1

Views: 427

Answers (2)

VBasic2008
VBasic2008

Reputation: 54767

Copy Data to Another Worksheet

Option Explicit

Sub CopyData()
    
    Const sName As String = "Sheet1"
    Const rgAddress As String = "G6:J106"

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets(sName)
    Dim rg As Range: Set rg = ws.Range(rgAddress)

    WriteCopyData rg

    ' or just:
    'WriteCopyData ThisWorkbook.Worksheets("Sheet1").Range("G6:J106")

End Sub

Sub WriteCopyData(ByVal SourceRange As Range)

    Const dName As String = "Sheet2"
    Const dRowAddress As String = "C6"
    Const dColumnAddress As String = "C5"
    
    Dim rCount As Long: rCount = SourceRange.Rows.Count
    Dim cCount As Long: cCount = SourceRange.Columns.Count
    
    Dim dws As Worksheet
    Set dws = SourceRange.Worksheet.Parent.Worksheets(dName)
    
    Dim dRow As Long: dRow = dws.Range(dRowAddress).Value
    Dim dCol As String: dCol = dws.Range(dColumnAddress).Value

    Dim dfrrg As Range: Set dfrrg = dws.Cells(dRow, dCol).Resize(1, cCount)
    Dim dlCell As Range
    Set dlCell = dfrrg.Resize(dws.Rows.Count - dRow + 1) _
        .Find("*", , xlFormulas, , xlByRows, xlPrevious)
    
    If Not dlCell Is Nothing Then
        Set dfrrg = dfrrg.Offset(dlCell.Row - dRow + 1)
    End If
    
    Dim drg As Range: Set drg = dfrrg.Resize(rCount)
    drg.Value = SourceRange.Value
    
End Sub

Upvotes: 1

FaneDuru
FaneDuru

Reputation: 42236

Please, try the next code:

Public Sub CopyData_()
    Dim InputSheet As Worksheet: Set InputSheet = ThisWorkbook.Worksheets("Sheet1")
    Dim InputRange As Range: Set InputRange = InputSheet.Range("G6:J106")
    Dim arr: arr = InputRange.Value
    
    Dim TargetSheet As Worksheet: Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")
    Dim TargetStartCol As String, PrimaryKeyRow As Long
    TargetStartCol = TargetSheet.Range("C5").Value       ' start pasting in this column in target sheet
    PrimaryKeyRow = TargetSheet.Range("C6").Value        ' this is the row after the result to be copied
    
    Dim InsertRow As Long

    InsertRow = TargetSheet.cells(TargetSheet.rows.Count, TargetStartCol).End(xlUp).row + 1
    If InsertRow < PrimaryKeyRow Then InsertRow = PrimaryKeyRow + 1 'in case of no entry after PrimaryKeyRow (neither the label you show: "Row")
    ' copy values to target row
    TargetSheet.cells(InsertRow, TargetStartCol).Resize(UBound(arr), UBound(arr, 2)).Value = arr
End Sub

Not tested, but if should work, I think. If something not clear or going wrong, please do not hesitate to mention the error, what it does/doesn't against you need or anything else, necessary to correct it.

Upvotes: 2

Related Questions