CODEWITHSUNDEEP
vbaexcel
Christopher Pieper
Christopher Pieper

Reputation: 35

combine two ranges (single cell and range) from multiple workbooks to worksheet

I got some script here to open up multiple workbooks with a worksheet and then copy it to a worksheet as a loop, but I need an additional cell (the date) from another worksheet in the multiple workbooks because the output I got cannot be changed and just added to the same sheet.

What I need is for this code to include a single cell range from another sheet on the workbook and then fill it to the bottom of the range per workbook.

I cant use UNION as it's not the same length, and I looked up merging ranges into one, but I get type mismatch errors.

VBA: How to combine two ranges on different sheets into one, to loop through I tried this but I can't figure out how to put it into my code.

Here is the code I have that works so far for just the one range. The rngdate copies over but does not leave a gap or autofill to the next loop, it just pastes under each other, so maybe this code will work but I'm missing something basic like 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

Upvotes: 0

Views: 162

Answers (1)

Tim Joy T-Square Consulting
Tim Joy T-Square Consulting

Reputation: 276

If I read your problem correctly you want the date, rngdate, pasted adjacent to each and every line of data you have just copied. However your current code only puts the data on the first row. Below is an adaptation of how I have solved this problem myself, taking account of your existing code. (My guess is that there is a much more elegant solution than this which I'm just not aware.)

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

Upvotes: 0

Related Questions