我写了一个代码,它将数据从一个工作簿复制到另一个工作簿,代码是
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上的数据过滤到A列,并将数据复制到另一个工作簿。 数据被完美复制,但我注意到它错过了数据的最后一行,例如,如果数据存在的最后一行是65434,它只会将数据复制到第65433行。
我已经尝试了所有方法来弄清楚这里出了什么问题,但没有运气。我相信声明
Set Dest = SheetTwo.Range("A" & Rows.Count).End(xlUp)
是错误的主要原因但不确定。
我相信数据会从SheetOne
完美地复制到sheetTwo
,但是当新数据来自另一个工作簿时,它会被覆盖。
答案 0 :(得分:2)
Set Dest = SheetTwo.Range("A" & Rows.Count).End(xlUp)
将dest设置为A列中包含数据的最后一个单元格。该行与转到工作表上的最后一个单元格然后按ctrl +向上箭头相同。这样做之后你需要退一行。
尝试:
Set Dest = SheetTwo.Range("A" & Rows.Count).End(xlUp).offset(1)
这将转到A列中的最后一个单元格,然后向下移动一个。