excel 使用VBA粘贴问题

gg58donl 于 2023-01-31 发布在其他

关注(0)|答案(2)|浏览(187)

祝你一切顺利。
我正在使用VBA编写代码，以查找和检测一个工作表中的错误，并将错误行中A列和B列的值粘贴到目标工作表中。我的代码基本上可以正常工作。我的问题是粘贴的内容是错误单元格和右侧的下一个单元格，而不是A和B列的值（例如：Imagine宏正在运行K列中的所有值，K85中存在错误，粘贴K85和L85，而不是A85和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

我怎样才能使它粘贴正确的单元格，我曾试图使用粘贴特殊，但我可能已经使用它错误，但我有错误，所有帮助apreciated。
祝你愉快。

excel

来源：https://stackoverflow.com/questions/75294992/pasting-issues-using-vba

2条答案

按热度按时间

smdnsysy1#

匹配错误值时复制值

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

赞(0）回复(0）举报 2023-01-31

31moq8wy2#

粘贴的是K85和L85，而不是A85和B85 *

尝试替换：

cell.Resize(1, 2).Copy firstBlank

与

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

要仅粘贴值，请改为执行以下操作：

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

赞(0）回复(0）举报 2023-01-31

我来回答

excel 使用VBA粘贴问题

2条答案

匹配错误值时复制值

相关问题

热门标签

最新问答