复制并粘贴最后一个空行和条件

时间:2017-06-25 16:51:23

标签: excel vba excel-vba

我想将属于某个表的列中的单元格值或文本粘贴到同一个表中的最后一个空行,但是位于不同的列和同一个工作表中

示例:

如果范围F12('对于所有列F)<>""然后

复制并粘贴E列中最后一个空行的文本

同样的原则适用于整个列F

非常感谢您的回复

代码:

Public Sub CopyRows2()
    Sheets("Sheet6").Select
    FinalRow = Cells(Rows.Count, 5).End(xlUp).Row   'find the last row of data
    For x = 2 To FinalRow                           'loop trough each row
        thisValue = Cells(x, 9).Value               'Decide to copy based on column I
        If thisValue <> "" Then
            Cells(x, 9).Copy
            Sheets("Sheet6").Select
            NextRow = Cells(Rows.Count, 5).End(xlUp).Row + 1
            Cells(NextRow, 5).Select
            ActiveSheet.Paste
            Sheets("Sheet6").Select
        Else
        End If
    Next x
End Sub

1 个答案:

答案 0 :(得分:0)

这将复制E列末尾的F列中的所有非空值(从第一个空单元格开始)

Option Explicit

Public Sub CopyRows()

    Const MAIN_SHEET    As String = "Sheet6"    '<- Update Sheet Name
    Const FROM_COL      As String = "F"         '<- Copy from this columns
    Const TO_COL        As String = "E"         '<- Copy to this column

    Dim lrFrom As Long, lrTo As Long, i As Long, val As String

    With Sheets(MAIN_SHEET)

        lrFrom = .Cells(.Rows.Count, FROM_COL).End(xlUp).Row    'last row in FROM col

        lrTo = .Cells(.Rows.Count, TO_COL).End(xlUp).Row + 1    'first empty row in TO

        Application.ScreenUpdating = False                      'turn off screen updating
        For i = 2 To lrFrom                                     'loop all values in FROM
            val = .Cells(i, FROM_COL).Value2
            If Len(val) > 0 Then                                'if not empty
                .Cells(lrTo, TO_COL).Value2 = val               'copy in TO col
                lrTo = lrTo + 1                                 'next cell in TO col
            End If
        Next
        Application.ScreenUpdating = True                       'turn on screen updating
    End With
End Sub

仅将最后一个非空单元格从F复制到E

中的第一个空单元格
Public Sub CopyRow()

    Const MAIN_SHEET    As String = "Sheet6"    '<- Update Sheet Name
    Const FROM_COL      As String = "F"         '<- Copy from this columns
    Const TO_COL        As String = "E"         '<- Copy to this column

    Dim lrFrom As Long, lrTo As Long, i As Long

    With Sheets(MAIN_SHEET)
        lrFrom = .Cells(.Rows.Count, FROM_COL).End(xlUp).Row    'last row in FROM col
        lrTo = .Cells(.Rows.Count, TO_COL).End(xlUp).Row + 1    'first empty row in TO

        .Cells(lrTo, TO_COL).Value2 = .Cells(lrFrom, FROM_COL).Value2
    End With
End Sub