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
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 theThisWorkbook
module (not toModule1
):
Option Explicit
Private Sub Workbook_Open()
CopyOnes
End Sub
- If you want to dig in deeper, here's a 'Play' version.
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.