我的 excel 檔案中有兩張表：
輸入表： Sheet1
目標表： Sheet2
我想要實作的是粘貼值從我在 cell 中定義的列C5開始，也從我在 cell 中定義的行開始C6。如果范圍的單元中定義C5和C6已有的資料，這時就會發現基于在單元格的列下一個空行C5并粘貼空行中的資料。
例如，在上面的螢屏截圖，起始列和行中的單元格定義C5＆C6是B8，所以復制的值將從單元開始被粘貼B8到E8。但是，如果該行已經有資料，那么它會根據列 B（即B9）找到下一個空行并將其粘貼到那里。
我不確定如何修改我當前的腳本：
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
任何幫助或建議將不勝感激！
測驗場景一
測驗場景 1 的輸出
uj5u.com熱心網友回復：
請嘗試下一個代碼：
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
未經測驗，但如果應該作業，我想。如果有什么不清楚或出錯的地方，請毫不猶豫地提及錯誤，它做什么/不反對您需要或其他任何需要糾正它的東西。
uj5u.com熱心網友回復：
將資料復制到另一個作業表
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/397052.html