CODEWITHSUNDEEP
excelvba
anuj kumar
anuj kumar

Reputation: 13

Excel VBA to copy 1st row of data of one sheet and paste to another sheet

I am trying to record a Micro for following task but failed.

There is three Sheets in workbook named Sheet1, Sheet2, Sheet3. sheet 1 have some column that reference to sheet 2 i want a micro that copy the data from sheet 2 first row and paste to sheet 3 and shift rest of data one row up in sheet 2 so new data is shown in sheet 1 .

I tried recording micro but after cut and then pasted data in 3rd sheet; sheet1 is started referencing to sheet3 automatically.

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

Upvotes: 0

Views: 1769

Answers (1)

VBasic2008
VBasic2008

Reputation: 54898

Copy Without Affecting Formulas

  • Adjust the values in the constants section (incl. the workbook) to fit your needs.
  • ThisWorkbook means the workbook containing this code.
  • This will 'move' the data in Source worksheet (src) from the specified first column (srcFirstCol) to the last column (srcLastCol) in a specified row (srcRow), to the specified row (tgtRow) in Target worksheet (tgt) starting from a specified column (tgtFirstCol).

The Code

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

Upvotes: 0

Related Questions