Question

我在这里有一些脚本用工作表打开多个工作簿，然后将其作为循环复制到工作表中，但是我需要从多个工作簿中的另一个工作表中添加一个单元格（日期），因为我得到的输出不能被更改，只是添加到同一张纸上。

我需要的是此代码包含工作簿上另一个工作表的单个单元格范围，然后将其填充到每个工作簿范围的底部。

我无法使用UNION，因为它的长度不一样，我查找将范围合并为一个，但是我遇到类型不匹配错误。

VBA: How to combine two ranges on different sheets into one, to loop through我试过了，但我无法弄清楚如何将它放入我的代码中。

这是我迄今为止只为一个范围工作的代码。 rngdate复制但没有留下间隙或自动填充到下一个循环，它只是粘贴在彼此之下，所以也许这个代码可以工作但我错过了像autofill这样基本的东西？

Dim vFileNames As Variant
Dim y As Long
Dim wbTemp As Workbook
Dim wbNew As Workbook
Dim blHeader As Boolean
Dim Rng As Range
Dim rngDate As Range

Application.ScreenUpdating = False
Set wbNew = Workbooks("master_timesheet") '.Add
blHeader = False
vFileNames = Application.GetOpenFilename(Title:="Select all workbooks to copy", _
MultiSelect:=True)
 'Will not be array if no file is selected
 'If user selects one or more files, files will be stored as an array
If Not IsArray(vFileNames) Then GoTo ConsolidateWB_End
For y = LBound(vFileNames) To UBound(vFileNames)
     'Open each wb selected
    Set wbTemp = Workbooks.Open(vFileNames(y))
    Set rngDate = wbTemp.Worksheets("Communications Unlimited Inc").Range("A5").CurrentRegion
    Set Rng = wbTemp.Worksheets("Export").Range("A1").CurrentRegion


     'If header row already copied, then offset by 1 to exclude header
    If blHeader Then
        Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
         'If header row not already copied, keep rng as is and change blHeader to true
    Else
        blHeader = True
    End If
     'Paste to next row on new wb

    Rng.Copy Destination:=wbNew.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0)
    rngDate.Copy Destination:=wbNew.Sheets(1).Range("P65536").End(xlUp).Offset(1, 0)

    wbTemp.Close SaveChanges:=False
Next y
    ConsolidateWB_End:
        Application.ScreenUpdating = True
End Sub

Answer 1

如果我正确地阅读了您的问题，您希望将日期，rngdate粘贴到您刚刚复制的每一行数据旁边。但是，您当前的代码仅将数据放在第一行。下面是我自己如何解决这个问题的改编，考虑到你现有的代码。（我的猜测是，有一个比我更不优雅的解决方案。）

Dim pasterangefirstrow As Integer

...

pasterangefirstrow = wbNew.Sheets(1).Range("D65536").End(xlUp).Offset(1, 0).Row

...

With wbNewSheets(1)
    Rng.Copy Destination:=.Range("D65536").End(xlUp).Offset(1, 0)
    rngdate.Copy Destination:=.Range("P" & pasterangefirstrow & ":P" & pasterangefirstrow + Rng.Rows.Count - 1)
End With

将多个工作簿中的两个范围（单个单元格和范围）组合到工作表中

1 个答案: