Excel VBA Macro: Copying relative cell to another

问题:

I am trying to fix missing entry by

1. finding it and then
2. copying the most left cell value relative to the found entry to the first empty bottom cell of another worksheet.

I am new to VBA and do not know how to figure this out. It is probably not hard to do, I just cannot figure it out from vba books I have.

   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  

***Update I found the answer somewhere else, it's probably not efficient, but here it is:

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

Thank you, Madi

回答1:

I think CurrentRegion will help you here.

e.g. If you had a value in every cell in the range A1:E4 then

Cells(1,1).CurrentRegion.Rows.Count would equal 4 and

Cells(1,1).CurrentRegion.Columns.Count would equal 5

Therefore you can write:

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

Provided you don't have any gaps in the middle of your destination spreadsheet, this will copy the user id from the beginning of the line with the "MissingUserInfo" (in the "Paste Pivot" sheet) to the first cell of a new row at the end of the "User Status" sheet.

Your Do Loop then becomes:

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