Макрос VBA – указание столбцов с копией.

У меня есть частично работающий макрос VBA, который копирует из одного листа «Средние оценки» в один из двух («SicknessRecordGraded», «SicknessRecordUngraded») при условии, что строка найдена в столбце 41 («GRADED», «UNGRADED»).
Я хочу, чтобы макрос копировал значения из столбцов B, C («AverageEarnings») в столбцы A, B на других листах из строки 3.
В настоящий момент он копирует столбцы B, C, D в столбцы A, B, C на другом листе из строки 3.
Кроме того, я получаю слишком много значений из исходного листа, из которых есть 4957. Вот мой макрос.

Public Sub CopyRowsSickness() ' This macro will copy rows in AverageEarnings spreadsheet, to Sheet1 if Ungraded (Column AO) or to Sheet2 if Graded. ' Insert message box to warn user. If MsgBox("This could take some time. (5 - 10 mins). Proceed?", vbYesNo) = vbNo Then Exit Sub ' Select initial sheet to copy from Sheets("AverageEarnings").Select ' Find the last row of data - xlUp will check from the bottom of the spreadsheet up. FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' For loop through each row For x = 1 To FinalRow ThisValue = Cells(x, 41).Value ' The value to check is located in Column AO or 41. If ThisValue = "UNGRADED" Then ' If the value is Ungraded Cells(x, 2).Resize(5000, 3).Copy ' Resize from intial range. Sheets("SicknessRecordUngraded").Select ' Specify first sheet to copy to. NextRow = Cells(3, 3).End(xlUp).Row + 1 ' <-- This line instead of next if you dont want paste over top. 'NextRow = Cells.Row + 1 ' Rows.Count, 1 Cells(NextRow, 1).Select ' Find the next row. ActiveSheet.Paste ' Paste information. Sheets("AverageEarnings").Select 'Reselect sheet to copy from. ElseIf ThisValue = "GRADED" Then Cells(x, 2).Resize(5000, 3).Copy Sheets("SicknessRecordGraded").Select NextRow = Cells(3, 3).End(xlUp).Row + 1 'NextRow = Cells.Row + 1 ' Increment row. ' Rows.Count, 1 Cells(NextRow, 1).Select ActiveSheet.Paste Sheets("AverageEarnings").Select End If Next x End Sub 

Я знаю, что проблема заключается в значениях этих двух линий. Я изменил их до самых разных значений, но пока не смог их исправить. Кажется, он вставляет гораздо больше значений, чем в «Средние оценки».

 Cells(x, 2).Resize(5000, 3).Copy NextRow = Cells(3, 3).End(xlUp).Row + 1 

Перед копированием вы изменяете размер диапазона, который нужно скопировать, чтобы он составлял 5000 строк по 3 столбца:

 Cells(x, 2).Resize(5000, 3).Copy 

Если вы хотите скопировать данные из столбцов B & C в этой строке, вам нужно только изменить размер до 1 строки по 2 столбца:

 Cells(x, 2).Resize(1, 2).Copy 

Обновлен для комментариев о данных, которые всегда вставлены в строку 3. При вставке данных строка определяется как:

 NextRow = Cells(3, 3).End(xlUp).Row + 1 

Это начинается с ячейки C3, перемещается вверх в пределах текущей области (как бы нажав END + UP), затем вниз на 1 строку. Это означает, что если у вас есть строка заголовка в C2, за которой следуют данные, вы вернетесь в ячейку C3, чтобы вставить данные. Предполагая, что нет ничего ниже вашего стола, я бы предложил:

NextRow = ячейки (1048576, 3) .End (xlUp) .Row + 1

Это работает снизу, чтобы найти последнюю строку с данными, затем берет ячейку ниже этого. Возможно, вам потребуется настроить значение строки для свойства Cells (1048576) в соответствии с количеством строк в вашей версии Excel.

Interesting Posts

Сохранение и загрузка конфигурации сводной таблицы во время выполнения

Скопируйте лист при обновлении ссылок на формулы ячейки

excel vba: функция возвращает значение странно

Quirks работают вокруг «числа, хранящегося в виде текста»

vba простой диапазон / ошибка объекта

Как несколько пользователей могут запускать макросы в общем файле excel?

Excel Interop добавляет косые черты в NumberFormat

Нулевые значения не записываются в пакет «org.zuinnote.spark.office.excel»

Как лучше обновить фильтр данных сводной таблицы?

Как скрыть строки, содержащие один номер из большого списка номеров деталей

Требуется объект, несмотря на уже определяющий объект (EXCEL, VBA)

Прочитайте базу данных Access, которая использует связанные таблицы с листами Excel

Ошибка аутентификации при использовании API-интерфейса Google SpreadSheet

Невозможно использовать INDIRECT в управлении формой в excel

Использование решателя в Excel VBA на mac

Давайте будем гением компьютера.