从一个工作簿到另一个工作簿的列中复制和粘贴最大值

时间:2013-06-14 14:40:17

标签: vba

我首先尝试找到列(C)中的最大值,然后将该值复制并粘贴到另一个(主)工作簿中“行3”中的下一个空单元格中。我正在运行的宏可以在主工作簿中找到。我发现这个代码我相信会将粘贴的单元格放到正确的位置,但我可以在代码中使用帮助来查找数据工作簿中C列中最大的单元格,然后复制并粘贴该值。

Private Sub CommandButton1_Click()
Dim wsMaster As Worksheet, wbDATA As Workbook
Dim NextColumn As Long, LastRow As Long

Set wsMaster = ThisWorkbook.Sheets("Contract Metrics")
NextColumn = wsMaster.Range("C", 3).End(xlUp).Column + 1

Set wbDATA = Workbooks.Open("C:\Documents and Settings\Michael Palkovitz\My Documents\Test\Contracts Metrics.xlsx")

wbDATA.Close False
End Sub

1 个答案:

答案 0 :(得分:0)

试试这个。首先对需要值的列进行排序,然后获取最后一行并将值放入主表第3行的第一个空列中。

' Create an excel application and open the workbook containing the data
Dim app As Object
Dim wb As Object
Dim ws As Object

Set app = CreateObject("Excel.Application")
Set wb = app.Workbooks.Open("C:\Workbook1")
Set ws = wb.Sheets(1)

' Get last row with a value to use for the sort range
Dim last As Long
Dim value As Long
With ws
    last = ws.Cells(ws.Rows.Count, 3).End(xlUp).row
    .Range("C1:C" & last).Sort Key1:=.Range("C2"), order1:=xlAscending, Orientation:=xlTopToBottom

    value = .Cells(last, 3)
End With

' Get the last filled cell and move over one to get the empty column

Dim col As Long
col = ActiveSheet.Cells(3, 1).End(xlToRight).Offset(0, 1).Column

ActiveSheet.Cells(3, col).value = value

wb.Close False
Set ws = Nothing
Set wb = Nothing
Set app = Nothing