從一張紙復制數據並移至其他問題

Question

我正在嘗試從工作表中復制一些行，然后粘貼到其他包含數據的工作表中。 稍后，我將刪除原始工作表中的數據以再次執行並重復該過程。

我的問題是，看起來我也在處理原始工作表中的空白單元格，因此當由於任何原因而粘貼時，excel會將此空白單元格視為最后一個空白單元格。 絕對可以確定我做錯了什么，宏是這樣的：

    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