Транспонировать столбцы в строки с 1 листа на другой лист с VBA с текущими столбцами

Question

У меня есть постоянно обновляемая электронная таблица, которую я использую для отслеживания проектов, но я хочу создать сводное представление для внутренних заинтересованных сторон. Я пытаюсь переместить мои столбцы в строки из листа с именем «Задачи» на лист с именем «Изменения оценки».

Я попытался записать макрос, и это то, что я записал:

Sub TransposeColToRow()
    ' TransposeColToRow Macro
    Range("B3:B14").Select
    Selection.Copy
    Range("B20").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub

Сообщение об ошибке гласит: Ошибка времени выполнения «1004»: этот выбор недействителен. убедитесь, что области копирования и вставки не перекрываются, если только они не имеют одинаковый размер и форму.

То, что у меня есть (новые проекты добавляются в качестве нового столбца, поэтому новый проект затем помещается в столбец). I):

Я хочу, чтобы строки 2-10 были перенесены на лист «Изменения оценки» следующим образом, поэтому новые столбцы будут транспонированыв новые строки:

Итак, в моем примере выше, когда я добавляю новый проект на лист «Задачи», проект добавляется в столбецI. Но когда я запускаю записанный мной макрос, появляется сообщение об ошибке, и новые строки не копируются в строки.

.

Я думал о добавлении кнопки и назначенииVBA к нему, чтобы каждый раз, когда вы щелкаете по нему, он обновлялся новыми столбцами и снова транспонировал. Но я не знаю, как это сделать. Я довольно новичок в VBA, поэтому ваша помощь очень ценится.

Answer 1

согласно вашим скриншотам, вы можете попробовать это:

With Sheets("Tasks").UsedRange
    .Resize(.Rows.Count - 1, .Columns.Count - 2).Offset(1, 2).Copy
End With

Sheets("Assessment Changes").Range("A6").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Answer 2

Я попробовал это, основываясь на вышеупомянутой обратной связи и некоторой помощи по поиску, и это сработало хорошо:

Sub Transpose_columns_to_rows()
  Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, j As Long
  Set sh1 = Sheets("Tasks")  'origin
  Set sh2 = Sheets("Assessment Changes")  'destiny
  sh2.Range("A6", sh2.Cells(Rows.Count, Columns.Count)).ClearContents
  lr = 6
  For j = 3 To sh1.Cells(2, Columns.Count).End(xlToLeft).Column
    sh2.Range("A" & lr).Resize(1, 10).Value = Application.Transpose(sh1.Cells(2, j).Resize(10).Value)
    lr = lr + 1
  Next
End Sub

Большое спасибо за вашу помощь!

Answer 3

Вот один из способов найти последний столбец для копирования:

Dim lastCol As Long

With Sheets("Tasks")
    'find the last used column on row 3
    lastCol = .Cells(.Columns.Count, 3).End(xlToLeft).Column
    .Range(.Range("B3"), .Cells(14, lastCol)).Copy
End With

'paste and translose
Sheets("Assessment Changes").Range("B3").PasteSpecial Paste:=xlPasteAll, _
              Operation:=xlNone, SkipBlanks:=False, Transpose:=True