Copy/Paste Adjacent Cells based on ActiveCell

Hello,

I am looking for a piece of code that will search through the data in column E and if the value in column E is #N/A, then it will copy the adjacent data in columns A-D into a new worksheet.

I have tried using Offset to select the 4 cells to the left of the activecell but I cannot select all 4 at the same time.

Any help is greatly appreciated!

Thank you!

Sam

Hi, Sam,

maybe this may give you a hint:

Sub EF917764()
Dim lngLast As Long
Dim lngCounter As Long
Dim lngCopy As Long

lngLast = Cells(Rows.Count, "E").End(xlUp).Row
lngCopy = 3

For lngCounter = 1 To lngLast
  If IsError(Cells(lngCounter, "E")) Then
    Sheets("new").Cells(lngCopy, "A").Resize(1, 4).Value = Cells(lngCounter, "A").Resize(1, 4).Value
    lngCopy = lngCopy + 1
  End If
Next lngCounter
End Sub

Cioa,
Holger

I think that may get me close, can you tell me if what I came up with is workable?

on the line that contains "If Activecell.Value = "N/A" Then" it kicks out a mismatch error

Dim i As Integer

    For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
        Range("e" & i).Select
        With ActiveSheet
            If ActiveCell.Value = "#N/A" Then
            ActiveCell.Offset(0, -4).Range("A1:D1").Select
            Selection.Copy Destination:=Sheets("Lookup").Range("B").End(xlDown).Row
            Else: End If
        End With
    Next i

Hi, brgr4u,

what does not available mean for Excel? An error occurred - maybe that´s why I used IsError.

And there is hardly one good reason to select each and every cell to work with ActiveCell (except a lot of unnecessary cursor movement and the macro recorder displaying code like that with Selection).

Ciao,
Holger

Hi, brgr4u,

do you have any formulas that you want to copy? I generally try to put values into the backup sheet as the data may show different results from what they showed on the original sheet.

Sub EF917764_2()
Dim lngLast As Long
Dim lngCounter As Long
Dim wsData As Worksheet
Dim wsCopy As Worksheet

Set wsData = Sheets("Apr Pivot")
Set wsCopy = Sheets("Lookup")

With wsData
  lngLast = .Cells(Rows.Count, "E").End(xlUp).Row
End With

For lngCounter = 1 To lngLast
  If IsError(wsData.Cells(lngCounter, "E")) Then
    With wsCopy
      .Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(1, 4).Value = wsData.Cells(lngCounter, "A").Resize(1, 4).Value
    End With
  End If
Next lngCounter

Set wsCopy = Nothing
Set wsData = Nothing
End Sub

Ciao,
Holger