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

Time:12-29

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!

CodePudding user response:

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.

CodePudding user response:

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 (instead all of the previous):
    '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 dws As Worksheet
    Set dws = SourceRange.Worksheet.Parent.Worksheets(dName)
    
    Dim dRow As Long: dRow = dws.Range(dRowAddress).Value
    Dim dCol As Variant: dCol = dws.Range(dColumnAddress).Value

    Dim dfCell As Range: Set dfCell = dws.Cells(dRow, dCol)
    Dim dlCell As Range
    Set dlCell = dfCell.Resize(dws.Rows.Count - dRow   1) _
        .Find("*", , xlFormulas, , , xlPrevious)
    
    If Not dlCell Is Nothing Then
        Set dfCell = dlCell.Offset(1)
    End If
    
    With SourceRange
        Dim drg As Range: Set drg = dfCell.Resize(.Rows.Count, .Columns.Count)
        drg.Value = .Value
    End With
    
End Sub
  • Related