VBA in Excel - Copy past values of a range of cells to other cells-CodePudding

Looking for some help,

I have created a command button and attached the following macro:

Private Sub CommandButton1_Click()
Range("J2:J3000").Copy
Range("G2:G3000").PasteSpecial xlPasteValues, xlNone, SkipBlanks
End Sub

The task im doing is very simple, copy values only from cells from range J2:J3000 to G2:G3000 but skip blanks when pasting to the corresponding row cell. (J2 copy, paste to G2) This isnt working as its overriding data in the range G2:G3000 with blanks from J2:J3000 instead of pasting the data only

To give context to the ranges.

J2:J3000 has a function

=IF(ISNA(VLOOKUP(A2,H:H,1,FALSE)),"","Yes")

which is checking data in the sheet that is manually pasted into column H:H and deleted with different data daily.

G2:G3000 has blank text cells where the results from J2:J3000 is then manually pasted to the corresponding row under column G.

(Basically, checking the value returned from the lookup, if it says yes then its manually copied to the cell in column G on the matching row.)

I am trying to introduce a button macro that can paste value returned the lookup and automate this process.

Private Sub CommandButton1_Click()
Range("J2:J3000").Copy
Range("G2:G3000").PasteSpecial xlPasteValues, xlNone, SkipBlanks
End Sub

CodePudding user response：

Your current method is overwriting everything in Column G

To correct this you can work with filtered ranges or utilize loops to conditionally update values in Column G. A loop solution is below:

Sub Test()

'Update the sheet name
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim i As Long

For i = 2 To 3000
    If ws.Range("J" & i).Value = "Yes" Then
        ws.Range("G" & i).Value = ws.Range("J" & i).Value
    End If
Next i

End Sub

For now this is manually hardcoded to stop at row 3,000. It is likely better to change this to be dynamic. To do this you just need to add a new variable (lr for 'last row') to store value of last row and modify the loop to iterate up until lr instead of the hardcoded value 3,000. Relevant bits of code are below

Dim i As Long, lr As Long

lr = ws.Range("J" & ws.Rows.Count).End(xlUp).Row

For i = 2 To lr
    'If .......
Next i

CodePudding user response：

You can use a loop to check each cell in column J. If the cell is not empty, add it to a range of cells that will be pasted into column G. Then, use another loop to paste the values in the correct rows of column G.

Private Sub CommandButton1_Click()
   Dim rngJ As Range, rngG As Range, rngPaste As Range
   Set rngJ = Range("J2:J3000")
   Set rngG = Range("G2:G3000")
   For Each cellJ In rngJ
      If cellJ.Value <> "" Then
         If rngPaste Is Nothing Then
            Set rngPaste = cellJ.Resize(1, 1)
         Else
            Set rngPaste = Union(rngPaste, cellJ.Resize(1, 1))
         End If
      End If
   Next cellJ
   rngPaste.Copy
   For Each cellG In rngG
      If cellG.Row = rngPaste.Row Then
         cellG.Value = rngPaste.Value
         Set rngPaste = rngPaste.Offset(1, 0)
      End If
   Next cellG
End Sub