將行從工作表複製到新工作表結尾Excel VBA

我在Excel中使用vba創建宏。我有一個for循環遍歷所有行，並將符合條件的特定行復制到新工作表。目前，這個宏的工作原理，我把它複製到相同的行號，但這導致空行存在，我擺脫了。有沒有辦法通過將行復制到最後一次使用的行之後來做到這一點？將行從工作表複製到新工作表結尾Excel VBA

這裏是我的代碼：

' Set the lastRow variable 
    lastRow = Worksheets("Original").Cells.Find("*", [A1], , , xlByRows, xlPrevious).ROW 

    ' The Total is in column K and the Class is in Column C 
    On Error Resume Next 
    For i = lastRow To 1 Step -1 
     ' Check the columns for Total and Class values 
     If (Worksheets("Original").Cells(i, "K").Value2) <> 0 Then 
      Worksheets("Original").Rows(i).Copy Worksheets("NEW WS").Cells(i, 1) 
      'Worksheets("Original").Rows(i).Copy Worksheets("NEW WS").Cells(Worksheets("NEW WS").Rows.Count, col).End(xlUp).ROW 
     ElseIf ((Worksheets("Original").Cells(i, "K").Value2) = 0) Then 
      If (Worksheets("Original").Cells(i, "C").Value2) < 81 Or (Worksheets("Original").Cells(i, "C").Value2) > 99 Then 
       Worksheets("Original").Rows(i).Copy Worksheets("NEW WS").Cells(i, 1) 
       'Worksheets("Original").Rows(i).Copy Worksheets("NEW WS").Cells(Worksheets("NEW WS").Rows.Count, col).End(xlUp).ROW 
      End If 
     End If 
    Next i 
Worksheets("NEW WS").Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

註釋行： Worksheets("Original").Rows(i).Copy Worksheets("NEW WS").Cells(Worksheets("NEW WS").Rows.Count, col).End(xlUp).ROW

不要工作。我不知道爲什麼。當我嘗試使用此代碼時，Excel不會將原始工作表中的任何內容複製到新工作表中。我怎樣才能使它工作？

來源

2013-12-18 RXC

你需要找到新的工作表的最後一排，把它加1，然後複製數據。要查找最後一行，請參閱[this]（http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba） –

繼我的意見，請參閱本

UNTESTED

Option Explicit 

Sub sample() 
    Dim wsO As Worksheet, wsI As Worksheet 
    Dim wsOLRow As Long, wsILRow As Long 

    Set wsO = ThisWorkbook.Worksheets("NEW WS") 
    Set wsI = ThisWorkbook.Worksheets("Original") 

    With wsO 
     If Application.WorksheetFunction.CountA(.Cells) <> 0 Then 
      wsOLRow = .Cells.Find(What:="*", _ 
          After:=.Range("A1"), _ 
          Lookat:=xlPart, _ 
          LookIn:=xlFormulas, _ 
          SearchOrder:=xlByRows, _ 
          SearchDirection:=xlPrevious, _ 
          MatchCase:=False).Row + 1 
     Else 
      wsOLRow = 1 
     End If 
    End With 

    With wsI 
     wsILRow = .Range("A" & .Rows.Count).End(xlUp).Row 
     For i = 1 To wsILRow 
      If .Cells(i, "K").Value2 <> 0 Then 
       .Rows(i).Copy wsO.Rows(wsOLRow) 
       wsOLRow = wsOLRow + 1 
      ElseIf .Cells(i, "K").Value2 = 0 Then 
       If .Cells(i, "C").Value2 < 81 Or .Cells(i, "C").Value2 > 99 Then 
        .Rows(i).Copy wsO.Rows(wsOLRow) 
        wsOLRow = wsOLRow + 1 
       End If 
      End If 

     Next i 
    End With 
End Sub

來源

2013-12-18 13:18:48

這不會複製我想要的所有內容，但它仍包含空白行。 – RXC

@RXC：我的歉意。我更新了代碼。現在測試它 –

它現在正在工作。謝謝！ – RXC

Worksheets("NEW WS").Cells(Worksheets("NEW WS").Rows.Count, col).End(xlUp).ROW - 返回一個數字，不粘貼複製的行

的位置爲它創建一個新的變量 - newLastRow = Worksheets("NEW WS").Cells(Worksheets("NEW WS").Rows.Count, col).End(xlUp).ROW

然後，當你想複製粘貼：

Worksheets("Original").Rows(i).EntireRow.Copy Worksheets("NEW WS").Range("A" & CStr(newLastRow + 1)).EntireRow應該工作或者沒有.EntireRow沒有機會測試這個抱歉。

來源

2013-12-18 13:16:26

'.EntireRow'不會影響任何內容。它仍然複製該行，但Excel將所有內容複製到第一行。我在循環的開始處每次迭代都分配newLastRow變量。 – RXC

將行從工作表複製到新工作表結尾Excel VBA

回答

相關問題