根据列名将数据复制并粘贴到另一个excel中，包括空白单元格

Question

我只是想根据列名将数据从一个 excel 提取到另一个 excel。源 excel 名称是“iTerm Export.xls”。工作表名称为“export(1)”。列标题是“资产”。因此，当运行以下宏资产列数据时，必须复制并粘贴到其他 excel 中，即（“iTerm metrics Report.xlsx”）

但是我的问题是，如果资产列中的任何地方都有一个空白单元格，例如：资产列中有 50 个数据行。但是第 25 和 30 是一个空白单元格。当我运行宏一次时，将 24 行复制并粘贴到另一个 excel 中。但我需要所有五十行都必须复制和粘贴在其他 excel 中包括空白行

Windows("iTerm Export.xls").Activate
Sheets("export(1)").Select
Cells.Find(What:="Asset", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("iTerm metrics Report.xlsx").Activate
Sheets("Raw Data from iTerm").Select
Range("A2").Select
ActiveSheet.Paste

请帮帮我。

谢谢

Answer 1

子 Create_From_List()

将行变暗为整数 行 = ActiveCell.Row

Dim objList As Worksheet
Set objList = ActiveSheet

Dim wb As Workbook
workingPath = ActiveWorkbook.Path

'插入您要传输到的文档（并将其保存在与源 excel 所在的文件夹相同的文件夹中）

Set wb = Workbooks.Add(workingPath & "\---") 

' 输入您从源复制的单元格，然后输入目标工作表的名称以及您要在目标工作表中放置信息的单元格。

CheckAndCopyData objList.Cells(- , -), wb.Sheets("---").Range("--") 
CheckAndCopyData objList.Cells(- , -), wb.Sheets("---").Range("--")
CheckAndCopyData objList.Cells(- , -), wb.Sheets("---").Range("--")
CheckAndCopyData objList.Cells(- , -), wb.Sheets("---").Range("--")
CheckAndCopyData objList.Cells(- , -), wb.Sheets("---").Range("--")
CheckAndCopyData objList.Cells(- , -), wb.Sheets("---").Range("--")


Application.DisplayAlerts = False

' 您可以使用您传输的信息作为文档的名称（使用源文档的单元格）

wb.SaveAs (workingPath & "\" & objList.Cells(- , -) & " " & objList.Cells(- , -) & 
".xlsx") 
Application.DisplayAlerts = True

End Sub

Function CheckAndCopyData(SourceCell As Range, TargetCell As Range)
If Not IsEmpty(SourceCell) Then

TargetCell.Value = SourceCell.Value
End If
End Function

Answer 2

阿鲁尔

我不建议您使用.Select，因为它是导致错误的主要原因。例如看这个帖子

Run Time Error '1004': Select method of Range Class failed VBA 2003

话虽如此，我还是建议直接执行您想要的操作，而不是先执行.Select。另外，您如何打开工作簿“iTerm Export.xls”和“iTerm metrics Report.xlsx”？如果在运行宏时它们已经打开，那么可以使用 .Activate 否则设置工作簿变量然后打开工作簿。这样您也可以避免使用.Activate。如果是这种情况，请告诉我，我会提供样本。

.Select 和 .Activate 的另一个缺点是它会大大降低您的代码速度。

您上面的代码也可以写成如下。这是使用.Find 而不是直接使用.Activate 的正确方法。原因是如果找不到匹配项，代码将在下一行崩溃。

Cells.Find(What:="Asset", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= False, _ SearchFormat:=False).Activate

因此建议检查是否找到该值，然后继续。

试试这段代码，看看这是不是你想要的？ （未测试）

Sub Sample()
    Dim aCell As Range

    Windows("iTerm Export.xls").Activate

    With Sheets("export(1)")
        Set aCell = .Cells.Find(What:="Asset", LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)

        '~~> Check if "Asset is found
        If Not aCell Is Nothing Then
            '~~> get the lastrow of the column which has "Asset"
            lastRow = .Range(Split(Cells(, aCell.Column).Address, "$")(1) & _
            .Rows.Count).End(xlUp).Row

            Windows("iTerm metrics Report.xlsx").Activate

            .Range( _
            Split(Cells(, aCell.Column).Address, "$")(1) & aCell.Row & _
            ":" & _
            Split(Cells(, aCell.Column).Address, "$")(1) & lastRow _
            ).Copy _
            Sheets("Raw Data from iTerm").Range("A2")
        Else
            MsgBox "Asset not found"
        End If
    End With
End Sub

HTH

席德

Answer 3

要获取列的最后一行，您可以这样做：

   lastRow = Selection.EntireColumn.Find(What:="*", after:=Range("A1"), _
        LookIn:=xlFormulas, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious).EntireRow.Row 'Use EntireRow to take hidden rows too

那么你可以：

Range(Selection, Cells(lastRow, Selection.Column)).Select

Answer 4

它停在空白处，因为这就是 xlDown 选择的作用。 我的建议是选择整个列。

Columns(4).Select

或

Columns("D:D").Select

或者，获取具有活动单元格的列

Columns(ActiveCell.Column).Select