在我的宏中粘贴以前粘贴的数据下方的新数据答案

【问题标题】：Pasting new data below previously pasted data in my macro在我的宏中粘贴以前粘贴的数据下方的新数据
【发布时间】：2022-07-21 00:18:43
【问题描述】：

我有以下程序，它从一张纸复制数据，然后将该数据的转置从不同的行粘贴到另一张。我在多次运行程序时遇到了一个问题，它不会将新数据粘贴到目标工作表中先前数据的下方，而是粘贴在先前的数据上。

我不确定如何实现这一点，此外，对于数组“DSCR”中的最后一个值，如果列中的“DSCR”仅复制第一个实例，则它不会复制第二个实例。

Option Explicit


Sub Extract()

    Dim arr, i As Long, f As Range, cPaste As Range, col As Long
    
    Dim wbPaste As Workbook, wsPaste As Worksheet, wsSrc As Worksheet, wSrc As Workbook
    
    

    arr = Array("DSCR Analysis", "Commercial Income", "Rental Income", "Other Income", _
            "Total All Income", "Rental Vacancy (%)", "Rental Vacancy ($)", _
            "Commercial Vacancy (%)", "Concessions/Bad Debt (%)", "Concessions/Bad Debt ($)", _
            "Effective Gross Income", "Total Expenses", "NOI", "Facility A Contractual Rate", _
            "MBI Debt Service", "Excess Cash Flow", "DSCR")
               Set wSrc = ActiveWorkbook
    Set wsSrc = ActiveWorkbook.Sheets("MBI DSCR")
    Set wbPaste = Workbooks.Open("C:\Users\bbarineau\OneDrive - Merchants Bancorp\Desktop\LBM_DSCT_DataLake.xlsm")
    Set wsPaste = wbPaste.Sheets(1) 'for example
 
     col = wsSrc.Columns.Find(What:="MBI", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False).Column
    
    Set cPaste = wsPaste.Range("C1") 'first header cell for pasted values
    
    For i = LBound(arr) To UBound(arr)
        
        cPaste.Value = arr(i) 'add the header
        Set f = wsSrc.Columns(col).Find(What:=arr(i), LookIn:=xlValues, _
                                    LookAt:=xlPart, MatchCase:=False)
        If i = 17 Then
        f = wsSrc.Columns(col).FindNext(f)
        End If
        
        
        If Not f Is Nothing Then
            f.Offset(0, 1).Resize(1, 6).Copy 'copy 6 columns next to the found cell
            cPaste.Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
                             Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        End If
        
        Set cPaste = cPaste.Offset(0, 1) 'next paste destination
    Next i

    wsPaste.Range("A1").Value = "Date Added"
    wsPaste.Range("B1").Value = "Name"
    
    Rows.AutoFit
    Columns.AutoFit
    wbPaste.Close SaveChanges:=True
End Sub

【问题讨论】：

标签： excel vba

【解决方案1】：

在 SO 上有很多现有的“查找最后使用的行”问题 - 使用其中一种方法并更改行

Set cPaste = wsPaste.Range("C1")

类似

Set cPaste = wsPaste.Cells(LastRow+1, "C")

例如查找最后使用的行：

LastRow = wsPaste.Cells.Find(What:="*", After:=wsPaste.range("a1"), _
               SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

【讨论】：