VBA Copy Range повторяется - PullRequest
       28

VBA Copy Range повторяется

0 голосов
/ 22 октября 2018

Я пытаюсь выбрать 14 строк в VBA, где я знаю номер метра (начальная ячейка).Эти строки повторяются в таблице.Я не получаю то, что хочу с этим кодом

Sub test()
Dim LastRow As Long


 Set sh = Sheets("Sheet1")

    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Worksheets("Sheet1").Activate

  For x = 0 To LastRow

    If Worksheets("Sheet1").Cells(x, 2) = "58117552" Then                       
         Range(Cells(x, 2), Cells(X, 2)+14).copy
    End If
  Next 
End sub

Спасибо за помощь.

enter image description here

1 Ответ

0 голосов
/ 22 октября 2018

Поскольку вы всегда хотите копировать 15 строк друг за другом, и в вашем примере число «Numéro de Compteuer» всегда появляется в 2, 16, 30 (каждый 15 шаг), вы можете пропустить функцию поиска и просто скопировать каждую15-й ряд и то, что ниже.

Вам нужно указать, куда вы хотите вставить скопированный диапазон ... Я только что взял Лист 2.

Что-то для начала:

Sub test()
Dim LastRow As Long
Dim sh As Worksheet
Dim sh2 As Worksheet
Dim X As Long

Set sh = Sheets("Sheet1") 'Define sheet to copy from
Set sh2 = Sheets("Sheet2") 'Define sheet to copy to

LastRow = sh.Cells(Rows.Count, 2).End(xlUp).Row 'Find last row to copy from

For X = 2 To LastRow Step 15 'Jump 15 step each time (since you are interested in every 15 row)
    If Worksheets("Sheet1").Cells(X, 2) <> "" Then 'If cell is empty then
         Range(sh.Cells(X, 2), sh.Cells(X + 14, 2)).Copy 'Copy the range, where 15 rows downward will be copied each time
         sh2.Range(sh2.Cells(X, 5), sh2.Cells(X + 14, 5)).PasteSpecial xlPasteValues 'Paste somewhere
    End If
  Next
Application.CutCopyMode = False
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...