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）你的代碼？它應該告訴你它所做的所有步驟，並且你將能夠看到它的行爲與你期望的不同。 –