VBA Excel - copy a range from all files in a directory and paste into one workbook cumulative on fir-CodePudding

I use a nice code, which is here:

Copying a range from all files within a folder and pasting into master workbook

I've changed the paste data from columns to rows by providing:

 shTarget.Cells(1, lRow).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

instead of:

 shTarget.Cells(1, lRow).PasteSpecial xlPasteValuesAndNumberFormats

and to works fine, although everything from the range is copied roughly to the same place. I would like the new data to be copied at the first empty row beneath the data copied earlier (from the first workbook in the directory).

I tried to modify my code by the example here:

https://www.mrexcel.com/board/threads/vba-paste-new-data-after-last-row.951096/

https://www.exceldemy.com/excel-vba-copy-paste-values-next-empty-row/

Copy and Paste a set range in the next empty row

by providing the offset as follows:

  shTarget.Cells(1, lRow).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

but it doesn't work as expected. The data is still copied to the same place several times. Eventually I have just the data from my last workbook in the directory.

My full code looks like this:

Sub CopyData(ByRef shSource As Worksheet, shTarget As Worksheet)
Const Bo As String = "A2:H100"
Dim lRow As Long
lRow = shTarget.Cells(Rows.Count, "A").End(xlUp).Row   1
 shSource.Range(Bo).Copy
 shTarget.Cells(1, lRow).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
 Application.CutCopyMode = xlCopy
 End Sub

If I change the

    lRow = shTarget.Cells(Rows.Count, "A").End(xlUp).Row   1

    lRow = shTarget.Cells(Rows.Count, "A").End(xlUp).Offset(1)

then I've got an error: Application defined or object defined error

Is there any way of copying the data on a cumulative basis? I.e. Data from first workbook regardless the range provided (A2:A100) occupies range just A2:A10 and consecutively the data from the 2nd workbook is copied to range A11:A30 and so forth?

CodePudding user response：

Copy Data Using a Method

A Quick Fix: Using the End Property (not recommended)

Sub CopyDataQF(ByVal shSource As Worksheet, ByVal shTarget As Worksheet)
    Const Bo As String = "A2:H100"
    Dim FirstRow As Long
    FirstRow = shTarget.Cells(shTarget.Rows.Count, "A").End(xlUp).Row   1
    shSource.Range(Bo).Copy
    shTarget.Cells(FirstRow, "A").PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
End Sub

An Improvement: Using the Find Method

Sub CopyData(ByVal shSource As Worksheet, ByVal shTarget As Worksheet)
    
    ' Define constants.
    Const SRC_RANGE As String = "A2:H100"
    Const TGT_FIRST_CELL As String = "A2"
    
    ' Reference the Source range.
    Dim srg As Range: Set srg = shSource.Range(SRC_RANGE)
    
    ' Reference the given first Target cell.
    If shTarget.FilterMode Then shTarget.ShowAllData
    Dim tfCell As Range: Set tfCell = shTarget.Range(TGT_FIRST_CELL)
    
    ' Reference the first available Target cell, the cell in the same column
    ' but in the row below the bottom-most non-empty row.
    With tfCell
        Dim tlCell As Range
        Set tlCell = .Resize(shTarget.Rows.Count - .Row   1, _
            shTarget.Columns.Count - .Column   1) _
            .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If Not tlCell Is Nothing Then
            Set tfCell = shTarget.Cells(tlCell.Row   1, tfCell.Column)
        End If
    End With
    
    ' Copy.
    srg.Copy
    tfCell.PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    
End Sub