2015-10-19 75 views
0

將數據複製到另一個工作簿中我寫的是複製數據的代碼從一個工作簿到另一個代碼錯誤而從一個工作簿缺少最後一排

Sub DataMerger() 
    Dim MyFileName As String, MyPath As String 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    MyPath = "C:\FilesToMerge\" 
    MyFileName = Dir(MyPath & "*.xl*") 

    Do Until MyFileName = "" 
     Workbooks.Open Filename:=MyPath & MyFileName 

     Dim ws As Worksheet 
     For Each ws In ActiveWorkbook.Sheets 

      If Len(ws.Name) > 1 Then 
       Worksheets(1).Activate 
       LastRow1 = ws.UsedRange.Row - 1 + ws.UsedRange.Rows.Count 
       strAddress2 = "T2:T" & LastRow1 
       wsName = ws.Name 
       ws.Range(strAddress2).Value = wsName 

       Dim DataBlock As Range, Dest As Range 
       Dim LastRow As Long, LastCol As Long 
       Dim SheetOne As Worksheet, SheetTwo As Worksheet 
       Set SheetOne = ActiveWorkbook.Worksheets(wsName) 
       Set SheetTwo = ThisWorkbook.Worksheets("Sheet1") 
       ' Set Dest = SheetTwo.Cells(1, 1) 
       Set Dest = SheetTwo.Range("A" & Rows.Count).End(xlUp) 
       MsgBox Dest, vbOKOnly, "Dest" 

       With SheetOne 
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1 
        MsgBox LastRow, vbOKOnly, "LastRow" 
        LastCol = .Cells(1, .Columns.Count).End(xlToRight).Column 
        MsgBox LastCol, vbOKOnly, "LastColumn" 
        Set DataBlock = .Range(.Cells(1, 1), .Cells(LastRow, LastCol)) 
       End With 

       With DataBlock 
        .AutoFilter Field:=1, Criteria1:="=*ON*" 
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Dest 
       End With 

       With SheetOne 
        .AutoFilterMode = False 
        If .FilterMode = True Then .ShowAllData 
       End With 

      End If 

      ActiveWorkbook.Close True 

     Next 

     wbName = ActiveSheet.Name 
     ActiveWorkbook.Save 
     MyFileName = Dir 

    Loop 
End Sub 

這個代碼將文件夾「FilestoMerge」和打開工作簿並將工作表(1)作爲活動工作表,然後將工作表的名稱複製到列T.

之後,它將列A上的數據過濾爲ON並將數據複製到另一個工作簿。 數據被完全複製,但我注意到它錯過了最後一行數據,例如如果最後一行數據存在是65434,它將只複製數據直到第65433行。

我試過所有的方法弄清楚在這方面出了什麼問題,但沒有運氣。我相信這樣的說法

Set Dest = SheetTwo.Range("A" & Rows.Count).End(xlUp) 

是錯誤的主要原因,但不知道。

我相信數據完全從SheetOne複製到sheetTwo,但是在新數據來自另一個工作簿時,它將被覆蓋。

回答

2
Set Dest = SheetTwo.Range("A" & Rows.Count).End(xlUp) 

設置dest爲列A中的最後一個單元格,其中包含數據。該行與表單上的最後一個單元格相同,然後按Ctrl +向上箭頭。這樣做後,你需要逐步減少一行。

嘗試:

Set Dest = SheetTwo.Range("A" & Rows.Count).End(xlUp).offset(1) 

這將轉到數據列中的最後一個單元格,然後向下移動一個。

+0

非常感謝你:) – mb1987

相關問題