简体   繁体   中英

Copy/paste below the last cell from both source and destination workbooks

I have a data entry workbook (DE WB)and I want to transfer data to a master workbook (MWB). The DE WB one can be 1-10 rows long, and then I have rows immediately below where signatures are required. The MWB is just an increasing list, so there is nothing below the last entry.

Below is my working code that is not transferring to the MWB. If I change my source row to just "A", then it copies, but it copies/pastes the signature lines as well. I am am looking for a way to just copy rows 1-10, depending on what has content.

Set wsCopy = ActiveWorkbook.Worksheets("Sheet1")
Set wsDest = Workbooks("Orders Log TEST.xlsx").Worksheets("FL")
    
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A10").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row

wsCopy.Range("A2:U" & lCopyLastRow).Copy _
wsDest.Range("A" & lDestLastRow)

Copy Non-Blank Rows

Sub BackupData()

    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    Dim sws As Worksheet: Set sws = swb.Worksheets("Sheet1")
    Dim srg As Range: Set srg = sws.Range("A2:U10")
    Dim scCount As Long: scCount = srg.Columns.Count
    
    Dim surg As Range
    Dim srrg As Range
    
    For Each srrg In srg.Rows
        If Application.CountBlank(srrg) < scCount Then
            If surg Is Nothing Then
                Set surg = srrg
            Else
                Set surg = Union(surg, srrg)
            End If
        End If
    Next srrg
    
    If surg Is Nothing Then Exit Sub ' all rows are blank
    
    Dim dwb As Workbook: Set dwb = Workbooks("Orders Log TEST.xlsx")
    Dim dws As Worksheet: Set dws = dwb.Worksheets("FL")
    Dim dlRow As Long
    dlRow = dws.UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    Dim dfCell As Range: Set dfCell = dws.Cells(dlRow + 1, "A")
    
    surg.Copy dfCell
    
    'dwb.Save
    
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM