将整行从一个工作簿复制到另一个工作簿

Question

我需要一个宏，它可以根据我选择的单元格从我所在的工作簿中复制整行。我已经可以这样做了，使用以下方法：

ActiveCell.EntireRow.Select

Selection.Copy

但是，我需要它将其（格式化和全部）粘贴到关闭的工作簿的第一个空行（基于B列）。R： \dasboards\wo。xlsm公司

Answer 1

• 调整常量部分中的值

Option Explicit

Sub BackupEntireRow()
    
    Const dFilePath As String = "R:\DashBoards\wo.xlsm"
    Const dwsName As String = "Sheet1"
    Const dlrCol As String = "B"
    
    Dim IsSuccess As Boolean
    
    If TypeName(Selection) <> "Range" Then
        MsgBox "No cells selected.", vbCritical
        Exit Sub
    End If
    
    Dim dwbName As String: dwbName = Dir(dFilePath)
    If Len(dwbName) = 0 Then
        MsgBox "Could not find the destination file" _
            & vbLf & "'" & dFilePath & "'", vbCritical
        Exit Sub
    End If
    
    Dim srrg As Range: Set srrg = ActiveCell.EntireRow
    
    Dim dwb As Workbook
    Dim dDoCloseWorkbook As Boolean
    On Error Resume Next
        Set dwb = Workbooks(dwbName)
    On Error GoTo 0
    If dwb Is Nothing Then
        Set dwb = Workbooks.Open(dFilePath)
        dDoCloseWorkbook = True
    End If
    
    Dim dws As Worksheet
    On Error Resume Next
        Set dws = dwb.Worksheets(dwsName)
    On Error GoTo 0
    
    If dws Is Nothing Then
        If dDoCloseWorkbook Then
            dwb.Close SaveChanges:=False
        End If
        MsgBox "The destination worksheet '" & dwsName & "' doesn't exist.", _
            vbCritical
        Exit Sub
    End If
    
    Dim dCell As Range
    Set dCell = dws.Cells(dws.Rows.Count, dlrCol).End(xlUp).Offset(1)
    Dim drrg As Range: Set drrg = dCell.EntireRow

    srrg.Copy drrg
    
    If dDoCloseWorkbook Then
        dwb.Close SaveChanges:=True
    Else
        dwb.Save
    End If
    
    IsSuccess = True
    
    If IsSuccess Then
        MsgBox "Row backed up.", vbInformation
    End If
    
End Sub