Home > Mobile >  Excel run VBA to copy a row on Sheet 1 and copy to Sheet 2
Excel run VBA to copy a row on Sheet 1 and copy to Sheet 2

Time:11-22

Hi I am after some advice as I have no VBA experience

I want to write a code so if column A displays the value "1" on sheet "2021" to copy the Row and paste to sheet "COPY" on the same row in that sheet.

With the paste I want to ignore all the links and formulas and just display the values in the row.

Any help would be appreciated. Thanks

enter image description here

CodePudding user response:

Copy to Exact Same Places

  • Copy this code into a standard module e.g. Module1 in the workbook where the worksheets reside. You will need to save the file as a macro-enabled workbook (.xlsm, alternatively .xlsb).
Option Explicit

Sub CopyOnes()
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
    Dim sws As Worksheet: Set sws = wb.Worksheets("2021") ' Worksheet
    ' When your 'table' range starts in 'A1' you can do it as easy as:
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion ' Range
    
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets("COPY") ' Worksheet
    ' When writing to the exact same 'places', you can do it as easy as...
    Dim drg As Range: Set drg = dws.Range(srg.Address) ' Range
    ' ... using the Source Range's address. Now you have created references
    ' to two exact same ranges on two different worksheets.
    
    Dim srrg As Range ' Current Source Row Range
    Dim r As Long ' Current Row Number (for Source and Destination)
    
    ' Loop through the rows of the Source Range...
    For Each srrg In srg.Rows
        ' Count the current row of the range (Source or Destination).
        ' In this case it is also the row of the worksheet but it need not be.
        r = r   1
        ' Check the first cell of the current row.
        If srrg.Cells(1).Value = 1 Then ' the cell contains 1
            ' Copy by assignment, the most efficient way to copy only values.
            drg.Rows(r).Value = srrg.Value
        'Else ' the cell does not contain 1
        End If
    Next srrg
    
    ' Let the user (yourself) know that something has happened.
    MsgBox "Row containing '1' copied.", vbInformation, "Copy Ones"
    
End Sub
  • To automatically use this every time you open the workbook you need to call it from an event procedure, particularly in this case, the Worksheet_Open procedure. Copy the following code to the ThisWorkbook module (not to Module1):
Option Explicit

Private Sub Workbook_Open()
    CopyOnes
End Sub
  • If you want to dig in deeper, here's a 'Play' version.

enter image description here

Sub CopyOnes()
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
    Dim sws As Worksheet: Set sws = wb.Worksheets("2021") ' Worksheet
    ' When your 'table' range starts in 'A1' you can do it as easy as:
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion ' Range
    
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets("COPY") ' Worksheet
    ' When writing to the exact same 'places', you can do it as easy as...
    Dim drg As Range: Set drg = dws.Range(srg.Address) ' Range
    ' ... using the Source Range's address. Now you have created references
    ' to two exact same ranges on two different worksheets.
    
    Dim srrg As Range ' Current Source Row Range
    Dim drrg As Range ' Current Destination Row Range
    Dim r As Long ' Current Row Number (for Source and Destination)
    
    ' Loop through the rows of the Source Range...
    For Each srrg In srg.Rows
        ' Count the current row of the range (Source or Destination).
        ' In this case it is also the row of the worksheet but it need not be.
        r = r   1
        
        ' Check the first cell of the current row.
        If srrg.Cells(1).Value = 1 Then ' the cell contains 1
            
            ' Create a reference to the Destination Row Range.
            Set drrg = drg.Rows(r)
            
            ' Copy by assignment, the most efficient way to copy only values.
            drrg.Value = srrg.Value
        
        ' This is the playground (additional functionality). You can safely
        ' delete all of it until the 'Else' or the 'End If' statements
        ' exclusively. If you wanna play, out-comment one or more lines
        ' and look at the worksheets to see the difference. You can also
        ' edit the lines e.g. 'vbRed', 'vbBlue' or 'False'. Just remember
        ' if you have messed up the worksheets,
        ' you can close the workbook without saving the changes.
        ' Do this slowly.
        
            ' Play in the Source:
            ' Highlight the whole row in yellow
            'srrg.Interior.Color = vbYellow
            ' Highlight only the first cell in green and use bold.
            'srrg.Cells(1).Interior.Color = vbGreen
            'srrg.Cells(1).Font.Bold = True
        
            ' Play in the Destination:
            ' Highlight the whole row in yellow
            'drrg.Interior.Color = vbYellow
            ' Highlight only the first cell in green and use bold.
            'drrg.Cells(1).Interior.Color = vbGreen
            'drrg.Cells(1).Font.Bold = True
        
        Else ' the cell does not contain 1
            
            ' Play in the Source:
            ' Highlight the whole row in green
            'srrg.Interior.Color = vbGreen
            ' Highlight only the first cell in yellow and use bold.
            'srrg.Cells(1).Interior.Color = vbYellow
            'srrg.Cells(1).Font.Bold = True
            
        End If
    
    Next srrg
    
    ' Let the user (yourself) know that something has happened.
    MsgBox "Row containing '1' copied.", vbInformation, "Copy Ones"
    
End Sub

CodePudding user response:

In AC5-AF5 there is a link to the DAY-MONTH-YEAR-HOUR date in the PLC where I am collecting the data =RSLINX|ENERGY_PLC!'CLOCK.DAY,L1,C1'. C4 is just a value.

enter image description here

  • Related