Excel VBA - Select and combine dynamic ranges

[Excel Novice 1]

Hi - Have never written a Macro before and am lost after reading several posts. I have 2 lists on separate tabs that are both dynamic in length. I want to copy them into a new tab and stack them.

For example - Go to 'Source Sheet 1', Copy range in Cell D6 to dynamic end, Paste in Cell D2 of 'Output Sheet'. Then go to 'Source Sheet 2', copy range in Cell D6 to dynamic end and paste after the end of the first copied range on 'Output Sheet'

I am currently using a vstack formula but want to migrate to VBA. Thanks for the help.

Been working with the following:

Sub copyStuff()
    Dim wsIn As Worksheet
    Set wsIn = Application.Worksheets("Source Sheet 1")

    Dim endRow As Long
    wsIn.Activate
    endRow = wsIn.Cells(wsIn.Rows.Count, "A").End(xlUp).Row

    Dim r As Range
    Dim wsOut As Worksheet
    Set wsOut = Application.Worksheets("Output Sheet")

    ' column d to column d
    Set r = wsIn.Range(Cells(2, 4), Cells(endRow, 4))
    r.Copy
    wsOut.Range("D1").PasteSpecial xlPasteAll

End Sub

 

[Joe4]

Welcome to the Board!

Try this:

Sub copyStuff()

    Dim ws1 As Worksheet, ws2 As Worksheet, wsO As Worksheet
    Dim lr1 As Long, lr2 As Long, lr3 As Long
    
'   Set sheet objects
    Set ws1 = Application.Worksheets("Source Sheet 1")
    Set ws2 = Application.Worksheets("Source Sheet 2")
    Set wsO = Application.Worksheets("Output Sheet")
    
'   Find last rows in column D on each Source sheet
    lr1 = ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row
    lr2 = ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row
    
'   Copy data from each source sheet to Output sheet
    ws1.Range(ws1.Cells(6, "D"), ws1.Cells(lr1, "D")).Copy wsO.Cells(wsO.Rows.Count, "D").End(xlUp).Offset(1, 0)
    ws2.Range(ws2.Cells(6, "D"), ws2.Cells(lr2, "D")).Copy wsO.Cells(wsO.Rows.Count, "D").End(xlUp).Offset(1, 0)

End Sub

 

[DanteAmor]

Try this:

Sub CombineDynamicRanges()
  Application.ScreenUpdating = False
  Sheets("Source Sheet 1").Range("D6", Sheets("Source Sheet 1").Range("D" & Rows.Count).End(3)).Copy
  Sheets("Output Sheet").Range("D2").PasteSpecial xlPasteValues
  Sheets("Source Sheet 2").Range("D6", Sheets("Source Sheet 2").Range("D" & Rows.Count).End(3)).Copy
  Sheets("Output Sheet").Range("D" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
  Application.ScreenUpdating = True
  Application.CutCopyMode = False
End Sub

 

[Skyybot]

Try this on a copy of your Workbook as unexpected results may occur. Place code in ThisWorkbook of VBE.

Sub CopyStuff()
Dim wb As Workbook, sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet
Dim rng1 As Range, rng2 As Range, lRow1 As Integer, lRow2 As Integer, lRow3 As Integer
Application.ScreenUpdating = False
Set wb = ThisWorkbook: Set sht1 = wb.Sheets("Source Sheet 1"): Set sht2 = wb.Sheets("Source Sheet 2")
Set sht3 = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count), Count:=1)
sht3.Name = "Combined"
lRow1 = sht1.Columns("D").Rows(sht1.Rows.Count).End(xlUp).Row
lRow2 = sht2.Columns("D").Rows(sht2.Rows.Count).End(xlUp).Row
Set rng1 = sht1.Range("D6:D" & lRow1): Set rng2 = sht2.Range("D6:D" & lRow2)
rng1.Copy sht3.Range("D2")
lRow3 = sht3.Columns("D").Rows(sht3.Rows.Count).End(xlUp).Row
rng2.Copy sht3.Range("D" & lRow3 + 1)
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[Trebor76]

Here's my attempt:

Option Explicit
Sub CopyStuff()

    Dim lngEndRow As Long, lngPasteRow As Long
    Dim wsFrom As Worksheet, wsTo As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsTo = ThisWorkbook.Worksheets("Output Sheet") '<-Sheet name for the data to be consolidated into. Change to suit if necessary.
    
    For Each wsFrom In ThisWorkbook.Worksheets
        'If the first 12 characters of the sheet name is 'Source Sheet', then...
        If Left(wsFrom.Name, 12) = "Source Sheet" Then
            '...copy the data from cell D6 from it and paste it into Col. D of the 'wsTo' tab
            lngEndRow = wsFrom.Cells(wsTo.Rows.Count, "D").End(xlUp).Row
            If lngEndRow > 6 Then
                lngPasteRow = wsTo.Cells(wsTo.Rows.Count, "D").End(xlUp).Row + 1
                wsFrom.Range("D6:D" & lngEndRow).Copy
                wsTo.Range("D" & lngPasteRow).PasteSpecial xlPasteAll
            End If
        End If
    Next wsFrom
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[Excel Novice 1]

Welcome to the Board!

Try this:

Sub copyStuff()

    Dim ws1 As Worksheet, ws2 As Worksheet, wsO As Worksheet
    Dim lr1 As Long, lr2 As Long, lr3 As Long
   
'   Set sheet objects
    Set ws1 = Application.Worksheets("Source Sheet 1")
    Set ws2 = Application.Worksheets("Source Sheet 2")
    Set wsO = Application.Worksheets("Output Sheet")
   
'   Find last rows in column D on each Source sheet
    lr1 = ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row
    lr2 = ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row
   
'   Copy data from each source sheet to Output sheet
    ws1.Range(ws1.Cells(6, "D"), ws1.Cells(lr1, "D")).Copy wsO.Cells(wsO.Rows.Count, "D").End(xlUp).Offset(1, 0)
    ws2.Range(ws2.Cells(6, "D"), ws2.Cells(lr2, "D")).Copy wsO.Cells(wsO.Rows.Count, "D").End(xlUp).Offset(1, 0)

End Sub

Thanks all for the input. I found Joe4's solution to be the easiest to understand from the perspective of have zero coding experience.

One follow-up question on the code in the last two rows. I see the Copy action but I don't see the Paste action. I'm interpreting the Copy action putting the data on the clipboard and then the Offset action as the paste. Is that a correct understanding? How would I modify this to Copy the data without formatting (i.e. Paste Values)? I tried adding some Paste Values code in place of and after the Offset but get a syntax error.

 

[Joe4]

One follow-up question on the code in the last two rows. I see the Copy action but I don't see the Paste action. I'm interpreting the Copy action putting the data on the clipboard and then the Offset action as the paste. Is that a correct understanding? How would I modify this to Copy the data without formatting (i.e. Paste Values)? I tried adding some Paste Values code in place of and after the Offset but get a syntax error.

Yes, if you do the Copy/Paste all on one line, you do not explicitly need to type in the word "Paste". You just put a space after the copy command and then the range you want to paste it to.
However, since you want a special paste option (values only), we will need to split it to two lines.

Try this:

Sub copyStuff()

    Dim ws1 As Worksheet, ws2 As Worksheet, wsO As Worksheet
    Dim lr1 As Long, lr2 As Long, lr3 As Long
    
'   Set sheet objects
    Set ws1 = Application.Worksheets("Source Sheet 1")
    Set ws2 = Application.Worksheets("Source Sheet 2")
    Set wsO = Application.Worksheets("Output Sheet")
    
'   Find last rows in column D on each Source sheet
    lr1 = ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row
    lr2 = ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row
    
'   Copy data from each source sheet to Output sheet
    ws1.Range(ws1.Cells(6, "D"), ws1.Cells(lr1, "D")).Copy
    wsO.Cells(wsO.Rows.Count, "D").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    
    ws2.Range(ws2.Cells(6, "D"), ws2.Cells(lr2, "D")).Copy
    wsO.Cells(wsO.Rows.Count, "D").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    
    Application.CutCopyMode = False

End Sub

 

[DanteAmor]

How would I modify this to Copy the data without formatting (i.e. Paste Values)? I tried adding some Paste Values code in place of and after the Offset but get a syntax error.

You would have tried my version of the post #3