Question

有没有办法将工作表名称添加到另一个工作表中的复制行？我已经将此代码从一张纸移到另一张

Sub move_row()

'Declare variables
    Dim sht1 As Worksheet
    Dim lastRow As Long

'Set variables
    Set sht1 = Sheets("Log")

'Select Entire Row
    Selection.EntireRow.Select

'Move row to destination sheet & Delete source row
    lastRow = sht1.Range("A" & sht1.Rows.Count).End(xlUp).Row

    With Selection
        .Copy Destination:=sht1.Range("A" & lastRow + 1)
        .EntireRow.Delete
    End With

End Sub

让我们说我有这种情况：我有3张名为：parts1，parts2，log的表上面的代码将整个行从活动工作表（仅使用A列和B列）移动到日志工作表。但有些时候part1和part2中的条目是相同的，我想知道通过在粘贴行的C列中添加工作表名称来移动它。有可能吗？

Answer 1

请尝试以下速度改进。分配新变量以跟踪源工作表名称，并将其复制到目标工作表中相应行的C列。

Sub move_row()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'Declare variables
Dim sht1, sht2 As Worksheet
Dim lastRow As Long

'Set variables
Set sht1 = Sheets("Log")
Set sht2 = ThisWorkbook.ActiveSheet
sheetName = sht2.Name

'Select Entire Row
Selection.EntireRow.Select

'Move row to destination sheet & Delete source row
lastRow = sht1.Range("A" & sht1.Rows.Count).End(xlUp).Row

With Selection
    .Copy Destination:=sht1.Range("A" & lastRow + 1)
    .EntireRow.Delete
End With
'After pasting and deletion of row, include the source sheet name in the         same row at column 3 (i.e. Column C)
sht1.cells(lastrow+1,3) = sheetName

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub

Answer 2

您的解决方案：

Sub move_row()

'Declare variables
    Dim sht1 As Worksheet
    Dim lastRow As Long
    Dim strShtName as String 'name of active sheet

'Set variables
    Set sht1 = Sheets("Log")

'Select Entire Row
    Selection.EntireRow.Select

'assign name of active sheet
    strShtName = ActiveSheet.Name

'Move row to destination sheet & Delete source row
    lastRow = sht1.Range("A" & sht1.Rows.Count).End(xlUp).Row

    With Selection
        .Copy Destination:=sht1.Range("A" & lastRow + 1)
        .EntireRow.Delete
    End With

'put sheet name in column C
    sht1.Range("C" & lastRow + 1).Value = strShtName

End Sub

Answer 3

不确定我是否使用ActiveSheet.Name。 Selection.Parent.Name可能会更好，因为ActiveSheet可能会在代码运行时发生变化，但同样可能会Selection。

此外，将源表名称添加到单元格中可能会在复制整行时覆盖值。也许把它添加为评论？

Sub Move_Row()

    Dim sht1 As Worksheet
    Dim lastrow As Long

    Set sht1 = ThisWorkbook.Worksheets("Log")
    lastrow = sht1.Range("A" & sht1.Rows.Count).End(xlUp).Row

    With Selection.EntireRow
        .Copy Destination:=sht1.Cells(lastrow + 1, 1)
        .Delete
    End With

    With sht1.Cells(lastrow + 1, 1)
        If .Comment Is Nothing Then
            .AddComment
            .Comment.Text Text:="Source Sheet: " & Selection.Parent.Name
        Else
            .Comment.Text Text:=.Comment.Text & Chr(10) & "Source Sheet: " & Selection.Parent.Name
        End If
    End With

End Sub

注意：代码实际上并没有选择EntireRow，只是引用它。

Excel VBA如何将源表名称添加到另一个工作表中的复制行

3 个答案: