Блог

У меня небольшая проблема. Собранный мной код берет данные из столбца A в sheet(1) и копирует их (перенося в строку) в sheet(2) . Хотя, прежде чем вставить это (вот момент, когда я начал записывать макрос), я нажимаю «control right», чтобы найти первую заполненную ячейку (в строке 2 (sheet(2) ), а затем выбираю вставить в данные, транспонируя их и заменяя данные, которые у меня там уже есть (в строку).

Проблема в том, что у меня есть 1000 столбцов, которые мне нужно перенести таким образом в строки (в каждом случае строка начинается в разных точках sheet(2) ) и заменить старые данные. Может кто-нибудь посоветовать, пожалуйста? Для этого потребуется какой-то цикл (я это знаю).

 Sub test()

Dim ws1, ws2 As Worksheet, lr As Long

Set ws1 = ThisWorkbook.Sheets(1): Set ws2 = ThisWorkbook.Sheets(2)

lr = ws1.Range("A" amp; ws1.Rows.Count).End(xlUp).Row

ws1.Range("A2:A" amp; lr).Copy

With ws2
'I have recorded this part
ws2.Activate
Range("A2").Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End With
End Sub
  

Несколько экранов для пояснения:

Здесь ws2, где данные начинаются в разных точках каждой строки (мне нужно, чтобы данные из ws1 были скопированы в ws2 и заменяли данные именно там, где они начинаются в каждой строке):

Попробуйте следующий код, пожалуйста:

 Sub testCopyTranspose()
 Dim ws1, ws2 As Worksheet, lr As Long, lastCol As Long, LastCol2 As Long, i As Long

 Set ws1 = ThisWorkbook.Sheets(1): Set ws2 = ThisWorkbook.Sheets(2)

 lastCol = ws1.cells(1 amp; Columns.count).End(xlToLeft).Column

 For i = 1 To lastCol
    lr = ws1.cells(Rows.count, i).End(xlUp).Row
    LastCol2 = ws2.cells(i   1, 1).End(xlToRight).Column
    ws1.Range(ws1.cells(2, i), ws1.cells(lr, i)).Copy
    ws2.cells(i   1, LastCol2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
                                               SkipBlanks:=False, Transpose:=True
 Next i
End Sub