我想将属于某个表的列中的单元格值或文本粘贴到同一个表中的最后一个空行,但是位于不同的列和同一个工作表中
示例:
如果范围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
答案 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