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

Question

Я уже давно ищу решение этой проблемы. Excel 2016/365, Win 10, оба x64.

У меня есть лист «Temp». Это скрытый лист, и его не нужно видеть. Данные вставляются в него с помощью кнопки на рабочем листе из буфера обмена Windows. Лист "Temp" не должен существовать, кроме как для выполнения задачи, для которой он необходим. Затем у меня есть код для копирования указанных c столбцов по их именам на другой лист «Анализ», после которого «Temp» очищается полностью. Может быть удален и воссоздан при необходимости в качестве опции.

Проблема с моим кодом. Он ищет столбцы по имени столбца и при необходимости копирует их в место назначения, однако исходные столбцы в «Temp» не всегда находятся в одном и том же порядке. Пример 1: дата, столбец 2, тип, столбец 4, цвет, столбец 6, что-то пример 2: тип, столбец 2, дата, цвет, столбец 5, столбец 6, что-то

При поиске этих столбцов они найдены, но скопированы в порядке их нахождения. Не порядок, в котором находится пункт назначения.

На листе назначения «Анализ» также есть заголовки столбцов. Пример: дата, тип, цвет, что-то, формула1, формула2, формула3 Столбцы формулы имеют значения поиска, основанные на некоторых других столбцах. Мне нужно также заполнить эти формулы с помощью VBA, но это может подождать.

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

Sub PasteFromClipboard()

    Application.ScreenUpdating = False
    ThisWorkbook.Sheets("Temp").Visible = True

    On Error GoTo ErrorHandler

    Sheets("Temp").Cells.ClearContents
    Sheets("Temp").Range("A1").PasteSpecial Paste:=xlPasteAll

    Application.CutCopyMode = False
    Sheets("Temp").Activate

    RenameColumnNames
    ThisWorkbook.Sheets("Temp").Visible = False
    Application.ScreenUpdating = True
    Sheets("Search").Activate
    MsgBox "Paste sucessful, Please click Analyse."


Exit Sub

ErrorHandler:
MsgBox "Nothing to paste!"
ThisWorkbook.Sheets("Temp").Visible = False
Sheets("Search").Activate
Application.ScreenUpdating = True
Exit Sub

End Sub

Sub Analyse() 'Excel VBA to move Columns based on criteria

    Application.ScreenUpdating = False

Dim ar As Variant, i As Long, rng As Range, shTemp As Worksheet, shAnal As Worksheet

Set shTemp = ThisWorkbook.Worksheets("Temp")
Set shAnal = ThisWorkbook.Worksheets("Analyse")
shTemp.Visible = xlSheetVisible
Set shTemp = ThisWorkbook.ActiveSheet
'Set the Array Values
ar = Array("CRN", "Customer Name", "Circuit/Equip ID", "Extension", "SLA", "Service Type", "Status")

For i = LBound(ar) To UBound(ar)
Set rng = shTemp.Rows(1).Find(ar(i), , xlValues).EntireColumn 'Loop through the Array
rng.Copy shAnal.Cells(1, i + 1)
Next
On Error GoTo ErrorHandler2

shAnal.Activate
shAnal.Columns.AutoFit
ActiveSheet.Cells(1, 1).Select
RefreshPivot ' Refresh the Pivot Tables
shTemp.Cells.ClearContents
shTemp.Visible = xlSheetHidden
Application.CutCopyMode = False
Application.ScreenUpdating = True

Exit Sub

ErrorHandler2:
MsgBox "Nothing to Analyse!"
shAnal.Activate
Range("A2:G2", Range("A2:G2").End(xlDown)).ClearContents ' Clears the contents of the Analyse sheet.
RefreshPivot 'Refresh the Pivot Tables
shTemp.Visible = xlSheetHidden
Sheets("Search").Activate
Application.ScreenUpdating = True
Exit Sub
End Sub

Sub RenameColumnNames()

    Application.ScreenUpdating = False
    ThisWorkbook.Sheets("Temp").Visible = True

    On Error Resume Next
    'Column names in the "Temp" sheet can have two possible variants of the column names

    With Selection.Find(What:="Cct No/Eq ID", After:=ActiveCell, LookIn:= _
        xlFormulas, lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext).Activate
    ActiveCell.Replace What:="Cct No/Eq ID", Replacement:="Circuit/Equip Id", _
        lookat:=xlWhole, SearchOrder:=xlByRows
    End With

    With Selection.Find(What:="Customer", After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Activate
    ActiveCell.Replace What:="Customer", Replacement:="Customer Name", lookat _
        :=xlWhole, SearchOrder:=xlByRows
      Range("A1").Select
    End With


    ThisWorkbook.Sheets("Temp").Visible = False
    Application.ScreenUpdating = True

End Sub