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

我在这里获得了一些脚本来打开多个工作簿并将其作为循环复制到工作表中，但是我需要一个额外的单元格）从多个工作簿中的另一个工作表中删除，因为我得到的输出无法更改，只能添加到同一张工作表中。将多个工作簿中的两个范围（单元格和范围）合并到工作表中

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

我不能使用UNION，因为它长度不一样，我查了一下合并范围，但是我得到了类型不匹配的错误。

VBA: How to combine two ranges on different sheets into one, to loop through我试过这个，但我想不出如何把它放到我的代码中。

这里是我的代码到目前为止仅适用于一个范围。 rngdate拷贝过来，但没有给下一个循环留下空隙或自动填充，它只是彼此粘贴，所以也许这个代码可以工作，但我缺少一些基本的自动填充？

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

来源

2017-06-29 Christopher Pieper

如果我正确地阅读了您的问题，您希望将日期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

来源

2017-07-05 06:00:20 tjejojyj

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

回答

相关问题