Question

我正在尝试编写代码以将数据从一个工作簿导入另一个工作簿。

源工作簿每次都会更改。

目标工作簿是历史统计信息

将数据导入源工作表：工作表2 后，我希望复制除标题和＆amp;之外的所有数据。粘贴在目标表的最后一行下方：工作表1

我能够将数据导入工作表工作表2 的第一部分。但我不知道为什么复制粘贴的代码即使运行并且没有错误也不会给出任何结果。所以，找不到错误，无法理解出了什么问题。

请帮我理解这个问题！谢谢！：）

这是我的代码：

public Object merge(String mapName, ReplicatedMapEntryView mergingEntry, ReplicatedMapEntryView existingEntry) {
    // every node knows its own values! (somehow existingEntry and mergingEntry are swapped?)
    // mergingEntry seems to be the destination (current local value)
    // existingEntry seems to be the value from the other member
    if (mergingEntry.getKey().equals(hazelcastUuid)) {
        return mergingEntry.getValue();
    } else {
        return existingEntry.getValue();
    }
}

Answer 1

我弄明白了这个错误。这条线

WS.Range(Cells(2, 1), Cells(LastRow, LastCol)).EntireRow.Copy Destination:=Sheets("Sheet 1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

应该在循环开始之前。否则代码在循环内运行并进入下一行。

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

'copy-paste after last row
WS.Range(Cells(2, 1), Cells(LastRow, LastCol)).EntireRow.Copy Destination:=Sheets("Sheet 1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

LetsContinue:
Application.ScreenUpdating = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub

VBA代码从一个工作表中复制数据＆amp;粘贴到另一个工作表的最后一行下面

1 个答案: