Question

我试图从工作表中复制一些行，然后粘贴到包含数据的其他工作表中。稍后我将删除原始工作表中的数据，以便再次完成并重复处理。

我的问题是，看起来我也应对原始纸张中的空单元格，所以当因任何原因粘贴时，请将此空单元格视为最后一个。我不确定我做错了什么，宏是这样的：

    Sub CopyTable()
'
' CopyTable Macro
'
'
' Variables
    Dim sht As Worksheet
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim StartCell As Range
    Set sht = Worksheets("Form")
    Set StartCell = Range("A9")

'Refresh UsedRange
    Worksheets("Form").UsedRange

'Find Last Row and Column
    LastRow = StartCell.SpecialCells(xlCellTypeLastCell).Row
    LastColumn = StartCell.SpecialCells(xlCellTypeLastCell).Column

'Select Range
    sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select

' Copy range and move to Data sheet
    Selection.Copy
    Sheets("Data").Select

' Place pointer on cell A1 and search for next empty cell
    Range("A1").Select
        Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
        Loop

' Once find, go back once to place on last empty and paste data from Form sheet no formating
    ActiveCell.Offset(0, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select


End Sub

Answer 1

我假设表单中的数据始终在A列中有一个条目 - 没有条目其中A为空，但该行上的其他单元格不为空白：

 Sub CopyTable()
 Dim sourcesheet As Worksheet
 Dim DestSheet As Worksheet
 Dim Source As Range
 Dim dest As Range
 Dim Startcell As Range
 Set sourcesheet = ThisWorkbook.Worksheets("Form")
 Set Startcell = sourcesheet.Range("A9")
 Set Source = sourcesheet.Range(Startcell, Startcell.SpecialCells(xlCellTypeLastCell))
 Set DestSheet = ThisWorkbook.Worksheets("Data")
 Set dest = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0)
  'set dest to next blank row
 Source.Copy dest
 Set dest = DestSheet.Range(dest, dest.SpecialCells(xlCellTypeLastCell))
 dest.Sort key1:=dest.Cells(1, 1)
 'sort to shift blanks to bottom
 End Sub

Answer 2

最后在stackoverflow中冲浪我发现了一些我确实需要的代码，所以最终宏看起来像这样：

Sub CopyTable()
Dim lastVal As Range, sht As Worksheet
Set sht = Sheets("Form")
Set lastVal = sht.Columns(2).Find("*", sht.Cells(1, 2), xlValues, _
                            xlPart, xlByColumns, xlPrevious)
Debug.Print lastVal.Address

sht.Range("A9", lastVal).Resize(, 26).Select 'select B:Ag


Selection.Copy
Sheets("Data").Select


Range("A1").Select
    Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop


ActiveCell.Offset(0, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("A1").Select

End Sub

从一张纸复制数据并转移到其他问题

2 个答案: