0
我正在尝试编写一个代码以将数据从一个工作簿导入到另一个工作表中。VBA代码从一个工作表中复制数据并粘贴到另一个工作表的最后一行下面
源工作簿每次都会更改。
的目标工作簿是历史统计
的数据导入到源工作表后：表2，我想整个数据&复制粘贴除了头最后一行下方目标表：表1
我能够做第一部分导入t他将数据存入工作表Sheet 2。但我不知道为什么复制粘贴代码即使运行并且没有错误也不会给出任何结果。所以，找不到错误，不能理解错在哪里。
请帮我理解问题！谢谢！ :)
这是我的代码：
Public Sub Add_Data()
Application.ScreenUpdating = False
Dim TabName As String
TabName = "Sheet 2"
ActiveSheet.Name = TabName
count1 = Workbooks("History Statistics.xlsm").Sheets.Count
Sheets(TabName).Copy After:=Workbooks("History Statistics.xlsm").Sheets(count1)
Workbooks("History Statistics.xlsm").Activate
MsgBox ("Data has been added to the master file")
Dim WS As Worksheet
Dim ColList As String, ColArray() As String
Dim LastCol As Long, LastRow As Long, i As Long, j As Long
Dim boolFound As Boolean
Dim delCols As Range
On Error GoTo Whoa
Application.ScreenUpdating = False
'~~> Set your sheet here
Set WS = Sheets("Sheet 2")
'~~> List of columns you want to keep. You can keep adding or deleting from this.
'~~> Just ensure that the column names are separated by a COMMA
'~~> The names below can be in any case. It doesn't matter
ColList = "Object Code, Points, Type, F, Module, Global Resp. Area"
'~~> Create an array for comparision
ColArray = Split(ColList, ",")
'~~> Get the last column
LastCol = WS.Cells.Find(What:="*", After:=WS.Range("A1"), Lookat:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
MatchCase:=False).Column
'~~> Get the last row
LastRow = WS.Cells.Find(What:="*", After:=WS.Range("A1"), Lookat:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'~~> Loop through the Cols
For i = 1 To LastCol
boolFound = False
'~~> Checking of the current cell value is present in the array
For j = LBound(ColArray) To UBound(ColArray)
If UCase(Trim(WS.Cells(1, i).Value)) = UCase(Trim(ColArray(j))) Then
'~~> Match Found
boolFound = True
Exit For
End If
Next
'~~> If match not found
If boolFound = False Then
If delCols Is Nothing Then
Set delCols = WS.Columns(i)
Else
Set delCols = Union(delCols, WS.Columns(i))
End If
End If
Next i
'~~> Delete the unwanted columns
If Not delCols Is Nothing Then delCols.Delete
LetsContinue:
Application.ScreenUpdating = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
WS.Range(Cells(2, 1), Cells(LastRow, LastCol)).EntireRow.Copy Destination:=Sheets("Sheet 1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End Sub
在结束时，符合'细胞（）'与片材太...'WS.Range（WS.Cells（2，1），WS.Cells（LASTROW，LASTCOL））。EntireRow.Copy目的地：=表格（“表格1”）。范围（“A”＆表格（“表格1”）.Rows.Count）.End（xlUp）.Offset（1，0）'？ – BruceWayne
@BruceWayne：我刚试过，但没有给我结果。 – Olivia
你的代码要复杂得多，我从你的描述中猜出来，请修改说明或删除代码中不相关的部分。你有没有尝试[调试]（http://stackoverflow.com/documentation/vba/802/getting-started-with-vba/15512/debugging#t=201705091527354062327）你的代码？它应该告诉你它所做的所有步骤，并且你将能够看到它的行为与你期望的不同。 –