根据集合参数复制列

时间:2016-03-11 15:47:32

标签: excel vba excel-vba

我正在将信息从一个工作簿复制到另一个工作簿。到目前为止,如果每列都有数据,我的代码都很有效。当我尝试将工作表的A列和B列(补充费用)中的信息重复复制到工作表(费用)而B列为空白时,它不起作用。当下次运行子程序并且B列确实具有值时,它们将被放置在下一个空白单元格中,而不是与列A相关联的单元格。

这是我到目前为止的代码:

Sub SupplementaryExpenses()

 Dim x As Workbook
 Dim y As Workbook

 Set y = Workbooks.Open("File Path")
 Set x = Workbooks.Open("File Path")


x.Sheets("b.1 Supplementary expenses").Range("a9", Range("a9").End(xlDown)).Copy
y.Sheets("Expenses").Range("a1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

x.Sheets("b.1 Supplementary expenses").Range("b9", Range("b9").End(xlDown)).Copy
y.Sheets("Expenses").Range("b1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

x.Sheets("b.1 Supplementary expenses").Range("c9", Range("c9").End(xlDown)).Copy
y.Sheets("Expenses").Range("c1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

此子运行的任何时候,如果有人用标志201601填充L列,然后在我引入下个月数据时更改为201602,将会很有帮助。

2 个答案:

答案 0 :(得分:0)

获取最后使用的行并更改与此类似的范围语句:

    Dim LastRow
    LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    x.Sheets("b.1 Supplementary expenses").Range(Cells(9, 1), Cells(LastRow, a)).Copy 'this is R1C1 format meaning row then column

您可以使用它来填充列 如果您将其放在代码的其余部分之后,并确保您拥有要填充活动的列L的工作表:

     sDate = Format(Date, "yyyymm")    
     For i = 2 To LastRow' you may need to grab this anew if you added lines
      If Cells(i, "L") = vbNullString Then 'ensures that there isn't anything in the cell
        Cells(i, "L").value = sDate
      End If
     Next

答案 1 :(得分:0)

试试这个:

Sub SupplementaryExpenses()

 Dim x As Workbook
 Dim y As Workbook
 Dim lastrow As Long
 Dim tRow as long


 Set y = Workbooks.Open("File Path")
 Set x = Workbooks.Open("File Path")
 With x.Sheets("b.1 Supplementary expenses")

     lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
     tRow = y.Sheets("Expenses").Range("a1").End(xlDown).Offset(1, 0).Row
     y.Sheets("Expenses").Range("A" & trow).Resize(lastrow - 8, 3).Value = .Range(.Cells(9, 1), .Cells(lastrow, 3)).Value
     y.Sheets("Expenses").Range("D" & trow).Resize(lastrow - 8, 1).Value = .Range(.Cells(9, 8), .Cells(lastrow, 8)).Value
 End With

End Sub

它将同时占用所有三列并将值分配给新区域。它不关心B列或C列中的空白。

这应该比复制/粘贴更快,因为你只需要值。