1

I am making VBA code to find errors from one sheet and paste the values from column A and B from the row of the error to the destination sheet.

My code is pasting the error cell and the cell to the right instead of the values from A and B.
Example: imagine the macro is running all values in column K and there is an error in K85, it is pasting K85 and L85, instead of A85 and B85.

Sub Copy_NA_Values()

Dim rng As Range
Dim firstBlank As Range
Dim shtSource As Worksheet
Dim shtDestination As Worksheet

Set shtSource = ThisWorkbook.Sheets("JE Royalty detail") 'Change to the name of the source sheet
Set shtDestination = ThisWorkbook.Sheets("DB") 'Change to the name of the destination sheet

Set rng = shtSource.Range("F:F").SpecialCells(xlCellTypeFormulas, xlErrors)

For Each cell In rng
    If IsError(Range("F:F")) = False Then
        Set firstBlank = shtDestination.Range("K" & Rows.Count).End(xlUp).Offset(1, 0)
        cell.Resize(1, 2).Copy firstBlank
    End If
Next cell

End Sub

I tried paste special but I had errors.

Community
  • 1
  • 1
  • 1
    You say **error in K85"* yet your code is looking only in column `F` for errors. It is unclear what needs to be copied to where. My guess is `A:B` to `A:B`. Please clarify. – VBasic2008 Jan 31 '23 at 09:41
  • 1
    *it is pasting K85 and L85, instead of A85 and B85* Try replacing `cell.Resize(1, 2).Copy firstBlank` with `shtSource.Range("A" & cell.Row & ":B" & cell.Row).Copy firstBlank`. Anyways, as said by @VBasic2008 your code looks kind of confusing in some parts. Please, clarify – Foxfire And Burns And Burns Jan 31 '23 at 09:45
  • Foxfire And Burns And Burns answer did it, sorry to be pushy but is there any way to paste only the values? it is taking the formatting which i would rather not have – Gonçalo Rocha Jan 31 '23 at 09:51
  • Please read this post: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba – Dominique Jan 31 '23 at 12:21

2 Answers2

2

it is pasting K85 and L85, instead of A85 and B85

Try replacing:

cell.Resize(1, 2).Copy firstBlank

with

shtSource.Range("A" & cell.Row & ":B" & cell.Row).Copy firstBlank

To paste only values, do this instead:

shtSource.Range("A" & cell.Row & ":B" & cell.Row).Copy
firstBlank.PasteSpecial (xlPasteValues)
0

Copy Values When Matching Error Values

Option Explicit

Sub BackupErrorValues()
    
    Const SRC_NAME As String = "JE Royalty detail"
    Const SRC_ERROR_RANGE As String = "F:F"
    Const SRC_COPY_RANGE As String = "A:B"
    Const DST_NAME As String = "DB"
    Const DST_FIRST_CELL  As String = "A2"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_NAME)
    Dim srg As Range
    On Error Resume Next ' to prevent error if no error values
        Set srg = Intersect(sws.UsedRange, sws.Columns(SRC_ERROR_RANGE)) _
            .SpecialCells(xlCellTypeFormulas, xlErrors)
    On Error GoTo 0
        
    If srg Is Nothing Then
        MsgBox "No cells with error values found.", vbExclamation
        Exit Sub
    End If
    
    Set srg = Intersect(srg.EntireRow, sws.Range(SRC_COPY_RANGE))
    Dim cCount As Long: cCount = srg.Columns.Count
    
    Dim dws As Worksheet: Set dws = wb.Sheets(DST_NAME)
    If dws.FilterMode Then dws.ShowAllData ' prevent failure of 'Find' method
    
    Dim dCell As Range
    With dws.UsedRange
        Set dCell = .Find("*", , xlFormulas, , xlByRows, xlPrevious)
    End With
    If dCell Is Nothing Then
        Set dCell = dws.Range(DST_FIRST_CELL)
    Else
        Set dCell = dws.Cells(dCell.Row + 1, dws.Range(DST_FIRST_CELL).Column)
    End If
    
    Dim drrg As Range: Set drrg = dCell.Resize(, cCount)
    
    Dim sarg As Range, srCount As Long
    
    For Each sarg In srg.Areas
        srCount = sarg.Rows.Count
        drrg.Resize(srCount).Value = sarg.Value
        Set drrg = drrg.Offset(srCount)
    Next sarg
    
    MsgBox "Error rows backed up.", vbInformation

End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28