Question

我有多张从ODBC中提取数据的工作表，并且会定期更新。这些表中的每一个跟踪不同的东西。例如，＆＃34;检查＆＃34;标签跟踪所有支票交易，＆＃34; CreditCardCharge＆＃34;标签跟踪所有CC交易......等。我为所有纸张创建了相同的标签。例如Date，Ref Num，Account Name，Memo，Amount ...等我每次更新文件时都需要将所有这些工作表映射到一个主数据转储表。

这是工作流程：

清除＆＃34; LP_DataDump＆＃34;中的所有数据标签从A2开始
复制＆＃34;检查＆＃34;选项卡数据从A3到Col J结束行
将复制的数据粘贴到＆＃34; LP_DataDump＆＃34;从A2开始
复制＆＃34; CreditCardCharge＆＃34;选项卡数据从A3到Col J结束行
将复制的数据粘贴到＆＃34; LP_DataDump＆＃34;从最后一个空行开始

我从下面开始，但它不起作用。

有人可以建议吗？

Sub CopyCheckValue()

Dim Check As Worksheet
Dim LastRow As Long

Set Check = Sheets("Check")
LastRow = Check.Cells(Check.Rows.Count, "A").End(x1Up).Row

Check.Range("A3:J" & LastRow).Copy _
        Destination:=Worksheets("LP_DataDump").Range("A2")

End Sub

Answer 1

表单“检查”是否仅包含您的数据？我可以猜一下，是不是因为跳过你的数据的.End方法？如果“检查”表中的最后一行是您的数据，.End方法将在其上方找到结尾。

LastRow = Check.Cells(Check.Rows.Count, "A").End(x1Up).Row

对此：

LastRow = Check.Rows.Count

如果列A和B的公式为空，而列C到J没有公式但只有数据，我建议使用下面的代码，假设C3始终有数据，C3之间没有空单元格和表的结尾。

LastRow = Check.Cells(3, "C").End(xlDown).Row

如果中间还有空单元格或其他列中的公式，请使用LastRow作为第一个建议。然后使用循环将值分配到另一个工作表中，而不是复制和粘贴整个范围。

PasteRow = 2
For RowCounter = 3 to LastRow
    If Check.Cells(RowCounter, "A") <> "" Then
        Check.Range(Cells(RowCounter, "A"),Cells(RowCounter, "J")).Copy
        Worksheets("LP_Datadump").Cells(PasteRow,"A").PasteSpecial Paste:= xlPasteValues
        PasteRow = PasteRow+1
    End If
Next

如果你有足够的行，我会在复制之前建议过滤，这样你就可以避免循环。这是代码，假设您希望根据A列过滤它。

LastRow = Check.Rows.Count
Check.Range("A3:J" & LastRow).AutoFilter Field:=1, Criteria:="<>"
Check.Range("A3:J" & LastRow).Copy
Worksheets("LP_Datadump"_.Cells(2, "A").PasteSpecial Paste:= xlPasteValues
Check.Range("A3:J" & LastRow).AutoFilter Field:=1

最后一列，行和范围复制从多个工作表粘贴到一个工作表

1 个答案: