Код VBA для перемещения столбцов только недавно вставленных строк данных
Как показано в смоделированной таблице выше, я пытаюсь написать макрос, который копирует новые данные из другой книги (OtherWorkBook), а затем вставляет их ниже существующей базы данных (в ThisWorkBook).
После этого только для новых строк данных, которые были вставлены, я хочу сдвинуть значения в столбцах A, B, C, D на одну ячейку вправо. Мой текущий код работает до тех пор, пока он не должен перемещать столбцы, но затем появляется ошибка.
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long
Dim ToCopy As Range
Dim ToPaste As Range
Set wsCopy = Workbooks("OtherWorkBook").Worksheets("OtherWorkSheet")
Set wsDest = Workbooks("ThisWorkBook").Worksheets("ThisWorkSheet")
CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
DestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
wsCopy.Range("A2:V" & CopyLastRow).Copy _
wsDest.Range("A" & DestLastRow)
Set ToCopy = wsCopy.Range("A2:V" & CopyLastRow)
Set ToPaste = wsDest.Range("A" & PasteToLastRow)
ToCopy.Copy ToPaste
Set ToPaste = ToPaste.Resize(ToCopy.Rows.Count, ToCopy.Columns.Count)
ToPaste.Columns("A:D").Cut
'The debugger highlights this line of code
ToPaste.Columns("D").Insert Shift:=xlToRight
Запись макросов невозможна, поскольку макрос периодически выполняется для добавления новых строк данных.
добавлено по запросу
Range("E:E").ClearContents тогда Range(A:A).InsertЯ пробовал, но выскакивает тот же код ошибки
Это вместо кода, который у вас есть.
Да, все равно показывает ошибку
Это не может быть так же, как нет копипаст.
внес дополнительные изменения, чтобы лучше прояснить мою проблему
Ответы 2
Попробуйте следующее:
Columns("D").Cut
Columns("E").Insert Shift:=xlToRight
Columns("C").Cut
Columns("D").Insert Shift:=xlToRight
Columns("B").Cut
Columns("C").Insert Shift:=xlToRight
Columns("A").Cut
Columns("B").Insert Shift:=xlToRight
К сожалению, мой компьютер с Microsoft Office не открыт, чтобы проверить, работает ли это, но вы сможете понять суть предложенного мной решения из приведенного выше.
я добавил больше строк кода в свое редактирование, которые могут вызывать мою проблему
Вы говорите, переместите значения, чтобы вы могли использовать Range.Value вместо вырезания/вставки.
Sub Demo()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long
Dim ToCopy As Range
Dim ToPaste As Range
Set wsCopy = Workbooks("OtherWorkBook").Worksheets("OtherWorkSheet")
Set wsDest = Workbooks("ThisWorkBook").Worksheets("ThisWorkSheet")
CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
DestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
' deleted redundant Copy/Paste here
Set ToCopy = wsCopy.Range("A2:V" & CopyLastRow)
Set ToPaste = wsDest.Range("A" & PasteToLastRow)
' copy the data
ToCopy.Copy ToPaste
' Resize ToPaste to the pasted rows, 4 columns
Set ToPaste = ToPaste.Resize(ToCopy.Rows.Count, 4)
' Move first 4 columns 1 column to right, leave formatting intact
ToPaste.Offset(, 1).Value = ToPaste.Value
' Clear the first column
ToPaste.Columns(1).ClearContents
End Sub
Пожалуйста, покажите код, который вы пытаетесь. Во-первых, вам нужно убедиться, что нет объединенных ячеек.