Excel VBA 復制一張表的第一行數據並粘貼到另一張表

Question

我正在嘗試為以下任務錄制 Micro 但失敗了。

工作簿中有三個工作表，名為 Sheet1、Sheet2、Sheet3。 工作表 1 有一些列引用工作表 2 我想要一個微型計算機，它從工作表 2 的第一行復制數據並粘貼到工作表 3，然后在工作表 2 中將數據的 rest 向上移動一行，因此新數據顯示在工作表 1 中。

我嘗試記錄微，但在剪切后將數據粘貼到第三張紙上； sheet1 開始自動引用 sheet3。

Sub Next_Data_1()

'

' Next_Data_1 Macro

'

 

'

    Sheets("Sheet2").Select

    Range("A1:U1").Select

    Selection.Cut

    Sheets("Sheet3").Select

    Selection.Insert Shift:=xlDown

    Sheets("Sheet2").Select

    Rows("1:1").Select

    Selection.Delete Shift:=xlUp

End Sub

Answer 1

復制而不影響公式

• 調整const ants 部分（包括工作簿）中的值以滿足您的需要。
• ThisWorkbook表示包含此代碼的工作簿。
• 這會將源工作表 ( src ) 中的數據從指定的第一列 ( srcFirstCol ) 移動到指定行 ( srcRow ) 中的最后一列 ( srcLastCol )，再到目標工作表 ( tgt ) 中的指定行 ( tgtRow )從指定的列 ( tgtFirstCol )。

編碼

Sub Next_Data()
    
' Constants
    
    ' Source
    Const srcName As String = "Sheet2"
    Const srcFirstCol As Variant = "A"   ' e.g. "A" or 1
    Const srcLastCol As Variant = "U"    ' e.g. "A" or 1
    Const srcRow As Long = 1
    
    ' Target
    Const tgtName As String = "Sheet3"
    Const tgtRow As Long = 1
    Const tgtFirstCol As Variant = "A"   ' e.g. "A" or 1
    
    ' Other
    Dim wb As Workbook: Set wb = ThisWorkbook
    
' Define worksheets.
    
    Dim src As Worksheet: Set src = wb.Worksheets(srcName)
    Dim tgt As Worksheet: Set tgt = wb.Worksheets(tgtName)
    
' Copy Row Range
    
    Dim rng As Range
    ' Define Row Range (rng) in Source worksheet (src).
    Set rng = src.Range(src.Cells(srcRow, srcFirstCol), _
                        src.Cells(srcRow, srcLastCol))
                              
    ' Insert an empty row in Target Row (tgtRow) in Target worksheet (tgt).
    tgt.Rows(tgtRow).Insert
    
    ' Copy values from Row Range (rng) to inserted row (tgtRow)
    ' in Target worksheet (tgt) starting from Target First Column (tgtFirstCol).
    tgt.Cells(tgtRow, tgtFirstCol) _
      .Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
    
' Remove Row Range
    
    ' Define last cell range containing data (rng).
    Set rng = src.Cells.Find("*", , xlValues, , xlByRows, xlPrevious)
    If rng Is Nothing Then Exit Sub ' Empty worksheet.
    
    ' Calculate Last Row containing data (LastRow).
    Dim LastRow As Long: LastRow = rng.Row

    ' Define the rows containing data (rng) starting from Source Row (srcRow).
    Set rng = src.Rows(srcRow & ":" & LastRow)
    
    ' 'Shift' the data one row up.
    rng.Value = rng.Offset(1).Value
        
' Inform user.
    
    MsgBox "Moved data successfully.", vbInformation, "Success"
    
End Sub