I have two sheets in my excel file:
Input Sheet: Sheet1
Target Sheet: Sheet2
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