复制可变范围的值而不是公式

时间:2017-01-06 01:29:32

标签: vba excel-vba excel

我试图将变量范围从一本书(Book1)复制到另一本书(book2)的变量范围的末尾。我只对第1册中变量范围的值感兴趣,这就是问题所在。所以我需要找到最后一行值(而不是公式)。在这个论坛上,我找到了几个选项,但在我的案例中没有一个可行。这是我得到的(请参阅代码的第二部分"复制详细信息USHB" - '选择要复制的单元格):

                ''''''Copy Detail by Vendor''''''
'Last cell in column

    Dim WS As Worksheet
    Dim LastCell As Range
    Dim LastCellRowNumber As Long
    Set WS = Worksheets("Detail by Vendor")
    With WS
    Set LastCell = .Cells(.Rows.Count, "B").End(xlUp)
    LastCellRowNumber = LastCell.Row + 1
    End With
    Dim wb As Workbook, wb2 As Workbook
    Dim vFile As Variant

'Set source workbook
Set wb = ActiveWorkbook

'Open the target workbook
Workbooks.Open Filename:= _
        "Book2.xlsm"
'Set selectedworkbook
Set wb2 = ActiveWorkbook

'Select cells to copy
Sheets("By Vendor").Select
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy

'Go back to original workbook you want to paste into
wb.Activate
Sheets("Detail by Vendor").Select

'Paste starting at the last empty row
wb.Worksheets("Detail by Vendor").Range("B" & LastCellRowNumber).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True

                    '''''Copy Detail USHB'''''
'Last cell in column
    Set WS = Worksheets("Detail USHB")
    With WS
    Set LastCell = .Cells(.Rows.Count, "B").End(xlUp)
    LastCellRowNumber = LastCell.Row + 1
    End With
'Activate the target workbook
wb2.Activate

'Select cells to copy
Sheets("Detail USHB").Select
Dim jLastRow As Long
jLastRow = Columns("B").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows,       SearchDirection:=xlPrevious).Row

Range(Selection, ActiveCell.SpecialCells(xlLastRow).Select
Selection.Copy

'Go back to original workbook you want to paste into
wb.Activate
Sheets("Detail USHB").Select

'Paste starting at the last empty row
wb.Worksheets("Detail USHB").Range("B" & LastCellRowNumber).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

1 个答案:

答案 0 :(得分:0)

根据您的意见,我相信您正在尝试执行以下操作:

    '...

    '''''Copy Detail USHB'''''
    Dim D As Range
    Dim S As Range
    With wb2.Worksheets("Detail USHB")
        'Locate the last non-blank value in source range
        LastRow = .Range("B:B").Find(What:="*", _
                                     LookIn:=xlValues, _
                                     SearchDirection:=xlPrevious).Row
        'Set range
        Set S = .Range("B2:B" & LastRow)
    End With 
    With wb.Worksheets("Detail USHB")
        'Find last used cell in destination range
        Set D = .Range("B" & .Rows.Count).End(xlUp)
        'Offset to next row, and resize appropriately
        Set D = D.Offset(1, 0).Resize(LastRow - 1, 1)
    End With
    'Copy values
    D.Value = S.Value
End Sub
相关问题