Кажется, я не могу запустить этот код, но я не вижу сообщения об ошибке. Мне нужно скопировать и вставить данные

#excel #vba

#превосходить #vba

Вопрос:

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

 Public Sub CopyData()   ' Define the object variables  Dim sourceWorksheet As Worksheet  Dim targetWorksheet As Worksheet   ' Define other variables  Dim searchStrings() As String ' -gt; Updated to hold multiple values   Dim lastSourceRow As Long  Dim startSourceRow As Long  Dim lastTargetRow As Long  Dim sourceRowCounter As Long  Dim columnToEval As Long  Dim columnCounter As Long  Dim searchCounter As Long ' -gt; New   Dim columnsToCopy As Variant  Dim columnsDestination As Variant   ' Adjust the worksheets names  Set sourceWorksheet = ThisWorkbook.Worksheets("Doug Clark")  Set targetWorksheet = ThisWorkbook.Worksheets("Doug Clark")   ' Define the number of columns to copy from one sheet to the other  columnsToCopy = Array(1, 2, 3, 4, 5, 6, 7)  columnsDestination = Array(11, 12, 13, 14, 15, 16, 17) ' -gt; This must have the same items' quantity as columnsToCopy   ' Set the string you're going to evaluate  searchStrings = Split("Off_Schedule", ",") ' -gt; Here the values are separated by commas in one single string (be careful of spaces between commas)   ' Adjust the initial row where data is going to be evaluated  startSourceRow = 12   ' Adjust the column where you evaluate if condition is met  columnToEval = 10   ' Find the number of the last row in source sheet (notice that this search in column A = 1)  lastSourceRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 10).End(xlUp).Row   For sourceRowCounter = startSourceRow To lastSourceRow   ' New -gt; Where need to iterate through each of the values in the search string array  For searchCounter = 0 To UBound(searchStrings)   ' Evaluate if criteria is met in column J = 10  If sourceWorksheet.Cells(sourceRowCounter, columnToEval).Value = searchStrings(searchCounter) Then   ' Get last row on target sheet (notice that this search in column A = 1)  lastTargetRow = targetWorksheet.Cells(targetWorksheet.Rows.Count, 12).End(xlUp).Row   For columnCounter = 0 To UBound(columnsToCopy)   ' You don't need to use copy and paste if values is all that you're passing  ' -gt; New See that I replaces the first columnsToCopy for columnsDestination  targetWorksheet.Cells(lastTargetRow, columnsDestination(columnCounter)).Offset(1, 0).Value = sourceWorksheet.Cells(sourceRowCounter, columnsToCopy(columnCounter)).Value   Next columnCounter   End If   Next searchCounter   Next sourceRowCounter   ' If this is necessary...  sourceWorksheet.Activate End Sub  

пожалуйста, помогите

Комментарии:

1. lastSourceRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 10).End(xlUp).Row разве вы не должны использовать колонку, которая columnsToCopy есть и нет 10 ?