需要在下一个空白区域粘贴信息

使用此代码，它将复制数据并将其粘贴到该名称所属的相应相应选项卡上，但是当我再次运行它以用于下一组数据时，最后的数据。我不知道如何空话贴添加到下一个空行需要在下一个空白区域粘贴信息

Dim c As Range, namesRng As Range 
    Dim name As Variant 

    With Worksheets("DRIVERS") '<--| reference "DRIVERS" worskheet 
     Set namesRng = .Range("A2", .Cells(.Rows.Count, "a").End(xlUp)) '<--| set the range of "drivers" in column "a" starting from row 4 down to last not empty row 
    End With 

    With CreateObject("Scripting.Dictionary") '<--| instance a 'Dictionary' object 
     For Each c In namesRng.SpecialCells(xlCellTypeConstants, xlTextValues) '<--| loop through "drivers" range cells with text content only 
      .Item(c.Value) = c.Value '<--| build the unique list of names using dictionary key 
     Next 
     Set namesRng = namesRng.Resize(namesRng.Rows.Count + 1).Offset(-1) '<--| resize the range of "names" to have a "header" cell (not a name to filter on) in the first row 
     For Each name In .Keys '<--| loop through dictionary keys, i.e. the unique names list 
      FilterNameAndCopyToWorksheet namesRng, name '<--| filter on current name and copy to corresponding worksheet 
     Next 
    End With '<--| release the 'Dictionary' object 
End Sub 

Sub FilterNameAndCopyToWorksheet(rangeToFilter As Range, nameToFilter As Variant) 
    Dim destsht As Worksheet 

    Set destsht = Worksheets(nameToFilter) '<--| set the worksheet object corresponding to passed name 
    With rangeToFilter 
     .AutoFilter Field:=1, Criteria1:=nameToFilter 
     Intersect(.Parent.UsedRange, .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow).Copy destsht.Cells(destsht.Rows.Count, "a").End(xlUp) 
     .Parent.AutoFilterMode = False 

    End With 
End Sub

来源

2017-08-17 Doug Gilmer

当提出与代码相关的问题时，为您使用的特定语言添加标签总是明智的。 *复制*和*粘贴*自己几乎没用。请[edit]在你的问题中包含适当的语言标签（excel-vba，它会出现）。你还应该解释你发布的代码如何不适合你。现在看来，这是一个*请为我写*代码后，我们不是一个代码写作服务。谢谢。 –

对不起，肯我第一次在论坛上问过。我会纠正verbage –

没问题。建议的话 - 这不是一个论坛，当你把它称为一个时，人们不喜欢它。 *论坛*意味着一个社交网站的讨论，这绝对不是这样一个网站。这完全是一个问题和答案网站。您可能需要花点时间参加[导览]并阅读[帮助]页面。 –

destsht.Cells(destsht.Rows.Count, "a").End(xlUp)

在上面的代码只需添加偏移（）到底。

destsht.Cells(destsht.Rows.Count, "a").End(xlUp).Offset(1)

来源

2017-08-17 04:35:25 Sixthsense

需要在下一个空白区域粘贴信息

回答

相关问题