根據列名將數據一個 excel 復制並粘貼到另一個 excel 包括空白單元格

Question

我只是想根據列名將數據從一個 excel 拉到另一個 excel。 源 excel 名稱是“iTerm Export.xls”。 工作表名稱是“export(1)”。 列標題是“資產”。 因此，當運行下面的宏資產列數據時，必須將其復制並粘貼到其他 excel 中，即（“iTerm 指標 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

阿魯

我不會建議您使用.Select因為它是導致錯誤的主要原因。 例如，請參閱此線程

運行時錯誤“1004”：范圍類的選擇方法失敗 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 2

要獲取列的最后一行，您可以改為執行以下操作：

   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 3

子 Create_From_List()

Dim Row As Integer Row = 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 4

它停在空白處，因為這就是 xlDown 選擇的作用。 我的建議是選擇整個列。

Columns(4).Select

或者

Columns("D:D").Select

或者，獲取具有活動單元格的列

Columns(ActiveCell.Column).Select