Ход для копирования данных с одного листа на другой с ограниченным выбором столбцов с использованием VBA

Question

Мне нужно скопировать данные с одного листа на другой с ограниченным выбором столбцов, используя VBA, а не непрерывно, и транспонировать скопированные данные в столбце при вставке на другой лист. Кроме того, я хочу при этом пропустить пустые ячейки.

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

    Option Explicit
Sub CopyPasteLoop()

    Dim X As Long
    Dim Y As Long
    Dim Col As Long
    Dim row1 As Long
    'Dim A As Long 

    Col = 1
    Sheets("Copy").Activate

    'For A = 1 To 10000    

    row1 = Sheets("Copy").Range(.Cells(.Rows.Count, Col)).End(xlUp).row

    Sheets("Key Entry Data").Activate
    X = Sheet2.Range("A" & Rows.Count).End(xlUp).row
    'Y = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column

    Sheets("Copy").Activate
    Sheet1.Range("Col" & 2, "Col" & row1).Select
    Selection.Copy

    'X = X + 1

    Sheets("Key Entry Data").Activate
    Sheet2.Cells(X).Select
    Sheet2.Range("A" & X).PasteSpecial xlPasteValues

    Col = ActiveCell.Next.EntireColumn.Cells(1).Select

    'Next X

End Sub

Answer 1

Спасибо, что поделились этим M.Schalk, я использую приведенный ниже код для копирования данных на другой лист. Можете ли вы взглянуть на код и поделиться со мной эффективным?

Опция Явный Sub EmailIDCopy ()

Dim X As Long 'X is the value of Row
Dim Y As Long
Dim Col As Long 'Col is used to column of Sheet2
Dim row1 As Long 'row1 is currently being used for defining the last row of column
Dim M As Long

    Col = 1
    Sheets("Copy").Activate

    For M = 1 To 5

    row1 = Sheets("Copy").Cells(Rows.Count, Col).End(xlUp).row
        Sheets("Key Entry Data").Activate
            X = Sheet2.Range("A" & Rows.Count).End(xlUp).row

    Sheets("Copy").Activate
        Sheet1.Range(Cells(2, Col), Cells(row1, Col)).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy


    X = X + 1
    Sheets("Key Entry Data").Activate
        Sheet2.Cells(X).Select
            Sheet2.Range("A" & X).PasteSpecial xlPasteValues

    Col = Col + 2
    Next M

End Sub

спасибо.

Answer 2

Как правило, вам следует избегать использования .Acitvate и .Select, как описано здесь . В вашем коде вы можете полностью исключить эти части. Это и неквалифицированные диапазоны (как указано в комментариях), скорее всего, являются причиной ваших проблем. Вот ваш исправленный код:

Option Explicit

Sub CopyPasteLoop()

Dim X As Long
Dim Y As Long
Dim Col As Long
Dim row1 As Long
'Dim A As Long

Col = 1
'For A = 1 To 10000
row1 = Sheets("Copy").Cells(Rows.Count, Col).End(xlUp).Row

X = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
'Y = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column

Sheet1.Range(Sheet1.Cells(2, Col), Sheet1.Cells(row1, Col)).Copy Sheet2.Range("A" & X)
'X = X + 1
'Next X
End Sub

Обратите внимание, что закомментированный цикл For не будет работать. Поскольку из вашего вопроса непонятно, чего должен достичь этот цикл, я не могу исправить это тем, что именно вы пытаетесь сделать. В общем, вам не нужно X = X + 1 внутри цикла For (он пропускает каждое второе целое число таким образом), поскольку об этом заботится оператор For ... To.