Question

我能够拼凑以下模块。该代码可以完美地复制正确的列数据，但是将行218定义为“最后一行”而不是实际的最后一行，即3929。巧合的是，行218和219在每个单元格中填充了数据，没有前导或尾随空格。如果我按行号定义最后一行

(TargetWS.Cells(3929, Cell.Column).PasteSpecial xlPasteValues)

模块正常工作。由于此代码将成为将单个员工数据复制/粘贴到所选特定通用标头的主表中的工作流的基础，因此以这种方式进行定义是不可行的。

我尝试从头开始创建数据库工作表，以确保没有归因于此问题的基本格式化问题，但没有任何乐趣。我知道我缺少一些小东西。

Sub CopyByHeader()

    Dim CurrentWS As Worksheet
    Set CurrentWS = ActiveSheet

    Dim SourceWS As Worksheet
    Set SourceWS = ActiveSheet
    Dim SourceHeaderRow As Integer: SourceHeaderRow = 1
    Dim SourceCell As Range

    Dim TargetWS As Worksheet
    Set TargetWS = Workbooks("4.4.5.3 Database.xlsx").Worksheets(1)
    Dim TargetHeader As Range
    Set TargetHeader = TargetWS.Range("A2:K2")

    Dim RealLastRow As Long
    Dim SourceCol As Integer

    SourceWS.Activate
    For Each cell In TargetHeader
        If cell.Value <> "" Then
            Set SourceCell = Rows(SourceHeaderRow).Find _
                (cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not SourceCell Is Nothing Then
                SourceCol = SourceCell.Column
                RealLastRow = Columns(SourceCol).Find("*", LookIn:=xlValues, _
                Searchorder:=xlByRows, SearchDirection:=xlPrevious).Row
                If RealLastRow > SourceHeaderRow Then
                    Range(Cells(SourceHeaderRow + 1, SourceCol), Cells(RealLastRow, _
                        SourceCol)).Copy
                TargetWS.Cells(RealLastRow + 1, cell.Column).PasteSpecial xlPasteValues
                End If
            End If
        End If
    Next

    CurrentWS.Activate

End Sub

Answer 1

我认为问题在于用于确定最后一行的Find（）方法。从文档的快速浏览中，我猜是因为行已满而被淘汰。

如果您的每一行中都有包含数据的列，则可以替换

RealLastRow = Columns(SourceCol).Find("*", LookIn:=xlValues, _
            Searchorder:=xlByRows, SearchDirection:=xlPrevious).Row

使用

RealLastRow = Cells(Rows.Count, colNum).End(xlUp).Row

其中“ colNum”是没有空单元格的列号（例如，列A为1）。

Answer 2

如果删除了原始工作表（Worksheet1）列，则具有复制值的工作表（Worksheet2）也不会被删除，从而导致复制值卡住。

根据列标题从InputWS复制/粘贴到TargetWS

2 个答案: