Простой массивный цикл копировать и вставлять

Question

Я новичок в VBA. Я использую один массив столбцов для данных переменных. Начиная с первой ячейки (A1), я хочу скопировать текстовое значение в A1, вставить в Sheet2, в A5, вернуться к массиву и сделать все заново, пока не доберусь до пустой ячейки. Легко ли?

Вот код, который у меня есть, я не могу скопировать значение и вставить его.

Спасибо, за ваши предложения !!!

Sub copylist() 
    ' copylist Macro 
    Worksheets("ID nbr").Select 
    Range("B3").Select 
    For Each c In Worksheets("ID nbr").Range("B3:B20").Cells 
     If c.Value <> "" Then 
      Sheets("ID nbr").Select 
      Dim rgCopy As Range 

      Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ 
       False, Transpose:=False 

      Range("B4:G4").Select 
      Application.CutCopyMode = False 
      Selection.Copy 
      Sheets("Findings").Select 
      Range("B4").Select 
      Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ 
       False, Transpose:=False 
     End If 
    Next 
End Sub 

Answer 1

Вы сделали большую попытку, используя магнитофон. Теперь давайте почистим его:

1. Я переместил все листы в переменные, чтобы ограничить количество ввода.

2. Я удалил все .Select и .Activate, они просто замедляют код и если они правильно указаны, они не нужны.

3. Когда требуются только значения, назначение их напрямую выполняется быстрее, чем использование буфера обмена. Мы можем сделать это как один блок ячеек.

4. Я использовал счетчик для перемещения вниз по одной строке на целевом листе для каждой строки, найденной на исходном листе.

Код:

Sub copylist() 
    Dim ows As Worksheet 
    Dim tws As Worksheet 
    Dim c As Range 
    Dim i As Long 

    Set ows = Sheets("ID nbr") 'Original sheet 
    Set tws = Sheets("Findings") 'Target sheet 
    i = 4 'this is the first row in the target sheet 

    With ows 
     For Each c In .Range("B3:B20").Cells 
       If c.Value <> "" Then 
        tws.Range(tws.Cells(i, "B"), tws.Cells(i, "G")).Value = .Range(.Cells(c.Row, "B"), .Cells(c.Row, "G")).Value 
        i = i + 1 
       End If 
     Next c 
    End With 

    End Sub