簡體   English   中英

Excel VBA宏:將相對單元格復制到另一個工作表

[英]Excel VBA Macro: Copying relative cell to another worksheet

我正在嘗試修復丟失的條目

  1. 找到它,然后
  2. 將相對於找到的條目的最左邊的單元格值復制到另一個工作表的第一個空的底部單元格。
   With Worksheets("Paste Pivot").Range("A1:AZ1000")
   Dim source As Worksheet
   Dim destination As Worksheet
   Dim emptyRow As Long
   Set source = Sheets("Paste Pivot")
   Set destination = Sheets("User Status")
   Set c = .Find("MissingUserInfo", LookIn:=xlValues)
   If Not c Is Nothing Then
    firstAddress = c.Address
    Do
                   'Here would go the code to locate most left cell and copy it into the first empty bottom cell of another worksheet  
       emptyRow = destination.Cells(destination.Columns.Count, 1).End(xlToLeft).Row
       If emptyRow > 1 Then
       emptyRow = emptyRow + 1
       End If
       c.End(xlToLeft).Copy destination.Cells(emptyRow, 1)
        c.Value = "Copy User to User Status worksheet"

        Set c = .FindNext(c)
        If c Is Nothing Then Exit Do
    Loop While c.Address <> firstAddress
End If
End With  

我認為CurrentRegion將在這里為您提供幫助。

例如,如果您在每個單元格中都有一個值在A1:E4范圍內,則

Cells(1,1).CurrentRegion.Rows.Count等於4並且

Cells(1,1).CurrentRegion.Columns.Count等於5

因此,您可以編寫:

c.End(xlToLeft).Copy _
    destination.Cells(destination.Cells(1).CurrentRegion.Rows.Count + 1, 1)

如果您在目標電子表格的中間沒有任何空隙,這會將用戶ID從帶有“ MissingUserInfo”(在“ Paste Pivot”表中)的行的開頭復制到新行的第一個單元格在“用戶狀態”表的末尾。

然后,您的Do Loop變為:

Do
    c.End(xlToLeft).Copy _
        destination.Cells(destination.Cells(1).CurrentRegion.Rows.Count + 1, 1)
    c.Value = "Copy User to User Status worksheet"
    Set c = .FindNext(c)
    If c Is Nothing Then Exit Do
Loop While c.Address <> firstAddress

由原始張貼者原始編輯為問題的答案:

With Worksheets("Paste Pivot").Range("A1:AZ1000")
Dim source As Worksheet
Dim sourceRowNumber As Long
Dim destination As Worksheet
Dim destCell As Range
Dim destCellRow As Long
Set source = Sheets("Paste Pivot")
Set destination = Sheets("User Status")
Set c = .Find("MissingUserInfo", LookIn:=xlValues)
If Not c Is Nothing Then
    firstAddress = c.Address
    Do

      With destination
       Set destCell = .Cells(.Rows.Count, "A").End(xlUp)
       destCellRow = destCell.Row + 1
        End With

       sourceRowNumber = c.Row

       destination.Cells(destCellRow, 1).Value = source.Cells(sourceRowNumber, 1)
       destination.Cells(destCellRow, 2).Value = source.Cells(sourceRowNumber, 2)
       destination.Cells(destCellRow, 3).Value = source.Cells(sourceRowNumber, 3)

       c.Value = "Run Macro Again"

        Set c = .FindNext(c)
        If c Is Nothing Then Exit Do
    Loop While c.Address <> firstAddress
End If
End With

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM