Question

我目前有一个包含所有数据的主工作表和一个将特定数据复制并粘贴到新工作表中的宏。我需要的是当特定数据粘贴到新工作表时，我需要重新排列列。目前就像这样

国家，HYP ID，客户编号，Inv No，Ord No，Ord Type，Prd No，FG / RM，船舶数量，销售Ccy，海外销售额px，销售额$，外币总金额

我想要的是：国家，HYP ID，客户编号，Inv No，Ord No，Ord Type，Prd No，FG / RM，船舶数量，销售Ccy，国外销售额px，外币总额，销售额$

我该怎么做？

Sub FilterANZ()
Dim ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim My_Range As Range
Dim CalcMode As Long
Dim ViewMode As Long
Dim FilterCriteria As String
Dim CCount As Long
Dim WSNew As Worksheet
Dim sheetName As String
Dim rng As Range
Dim Found As Range
Dim LR As Long
Dim bottomN As Integer
    Set My_Range = Range("A1:AF" & LastRow(ActiveSheet))
    My_Range.Parent.Select


   'Change ScreenUpdating, Calculation, EnableEvents, ....
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    ActiveSheet.DisplayPageBreaks = False


'Firstly, remove the AutoFilter
  My_Range.Parent.AutoFilterMode = False
 My_Range.AutoFilter Field:=1, Criteria1:="=AUS", Operator:=xlOr, Criteria2:="=NZD"

Set rng1 = Range("f1:g1, j1,l1: n1 , p1: q1 , s1: u1,w1,ag1,y1 ")
Set rng2 = rng1.EntireColumn.Find("*", [f1], , , , xlPrevious)
Set rng1 = Intersect(rng1.EntireColumn, Rows(rng1.Row & ":" & rng2.Row))

Set ws = Sheets.Add
ws.Name = "ANZ"
rng1.Copy ws.[a1]
Application.CutCopyMode = False

Set btn = ANZ.Buttons.Add(390, 61.5, 94.5, 31.5)

    'Lable button
    btn.Characters.Text = "Reorder"

    'Assign existing macro (Macro1) to button
    btn.OnAction = "reorder"





 End Sub

Answer 1

可以将以下代码添加到现有宏中以更改列顺序（您所做的只是切换最后两列）：

Columns("L:L").Select
Selection.Cut Destination:=Columns("N:N")
Columns("L:L").Select
Selection.Delete Shift:=xlToLeft

创建工作表后重新排列列

1 个答案: