使用endxldown函数复制和粘贴无限数据

时间:2017-05-17 15:06:00

标签: excel vba excel-vba

我正在尝试将数据从一个工作簿复制并粘贴到另一个工作簿中。当范围是静态时,此功能有效,但我无法使其成为动态。我知道endxldown函数是为了这个,但我将如何将其用于我的代码:

Private Sub CommandButton21_Click()

Dim itemName As String

Dim itemPrice As Single

Dim myData As Workbook


Worksheets("Sheet1").Select

itemName = Range("A2")

Worksheets("Sheet1").Select

itemPrice = Range("B2")

Set myData = Workbooks.Open("C:\Users\Iraj.Masud\Desktop\testing\Master.xlsm")
Worksheets("Sheet1").Select

Worksheets("Sheet1").Range("A1").Select

RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Sheet1").Range("A1")

.Offset(RowCount, 0) = itemName

.Offset(RowCount, 1) = itemPrice

End With
myData.Save

End Sub

我的修改在下图中突出显示。当我运行宏时,我收到了一个对象变量或未设置的块变量。

Code with Error

4 个答案:

答案 0 :(得分:1)

我猜:

With Worksheets("Sheet1")
    With .Range("A" & .Rows.Count).end(xlUp)
        .Offset(1, 0) = itemName
        .Offset(1, 1) = itemPrice
    End With
End With

答案 1 :(得分:0)

试试这个,(我清理了你的代码),另请参阅为rowcount设置值的指令

    Private Sub CommandButton21_Click()

    Dim rowcount As Long
    Dim myData As Workbook

    With Worksheets("Sheet1")
        .Range("A2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row).Copy
    End With
    Set myData = Workbooks.Open("C:\Users\Iraj.Masud\Desktop\testing\Master.xlsm")
    With myData.Worksheets("Sheet1")
        rowcount = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(rowcount, 1).Paste
    End With
    myData.Save

End Sub

答案 2 :(得分:0)

使用底部的End(xlUp)来捕获最后一行,这比使用xlDown更好,因为后者将捕获第一个空行,而不是最后一行。

删除所有不必要的Select内容并使用数组,您的代码可以简化为:

Private Sub CommandButton21_Click()
  With Workbooks.Open("C:\Users\Iraj.Masud\Desktop\testing\Master.xlsm").Sheets("Sheet1")
    .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(1, 2).Value = _
        ThisWorkbook.Sheets("Sheet1").Range("A2:B2").Value2
    .Parent.Close True
  End With
End Sub

请注意,所有引用都是显式的,没有对任何工作簿或工作表处于活动状态的隐式引用。这通常会产生更安全的代码。

修改

如果要从源复制所有A:B数据,请使用:

Private Sub CommandButton21_Click()
  Dim src as Range
  Set src = ThisWorkbook.Sheets("Sheet1").Range("A2", ThisWorkbook.Sheets("Sheet1").Range("B999999").End(xlUp)
  With Workbooks.Open("C:\Users\Iraj.Masud\Desktop\testing\Master.xlsm").Sheets("Sheet1")
    .Cells(.Rows.Count, "A").End(xlUp).Offset(1) _
       .Resize(src.Rows.Count, src.Columns.Count).Value = src.Value2
    .Parent.Close True
  End With
End Sub

答案 3 :(得分:0)

Private Sub CommandButton21_Click()

Dim itemName As String
Dim itemPrice As Single
Dim wbData As Workbook
Dim wsData As Worksheet
Dim newData As Range

With ThisWorkbook.Worksheets("Sheet1")  '<~defines that we are working on sheet1
  itemName = .Range("A2")               '<~gets the itemname
  itemPrice = .Range("B2")              '<~gets the itemprice
End With

Set wbData = Workbooks.Open("C:\Users\Iraj.Masud\Desktop\testing\Master.xlsm")  '<~opens then workbook
Set wsData = wbData.Worksheets("Sheet1")                                        '<~sets the worksheet
Set newData = wsData.Range("A1048576").End(xlUp).Offset(1, 0)                   '<~locate last cell and offset 1 row below

With newData                            '<~defines that we are working with the cell below the last non-blank cell
  .Offset(0, 0).Value = itemName        '<~passes the item name
  .Offset(0, 1).Value = itemPrice       '<~passes the item price
End With

Set newData = Nothing                   '<~post procedure cleaning
Set wsData = Nothing                    '<~post procedure cleaning

wbData.Save                             '<~save
wbData.Close

End Sub

这可能是一个粗糙的代码。但IMO,如果您想要更改代码的某些部分,这是灵活的。