2013-05-01 5 views
0

Я пытаюсь исправить недостающую запись наExcel VBA макросы: Копирование относительно ячейки на другой лист

  1. найти его, а затем
  2. копирования наиболее левое значение ячейки относительно найденной записи на первый пустой нижний ячейку другого листа.

Я новичок в VBA и не знаю, как это понять. Это, вероятно, не сложно сделать, я просто не могу понять это из книг VBA, которые у меня есть.

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 

*** Обновление Я нашел ответ где-то еще, это, вероятно, не является эффективным, но здесь это:

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 

Спасибо, Мади

ответ

0

Я думаю 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) 

условие, что вы не имеют пробелов в середине вашей таблицы назначения, это скопирует идентификатор пользователя с начала строки с помощью «MissingUserInfo» (на листе «Paste Pivot») в первую ячейку новой строки на конец «U ser Status ".

Ваш 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 
Смежные вопросы