Excelmacros根据用户偏好删除列

新手在这里…已经使用这个网站多次获得答案，但无法find我最近的挑战之一。

我想创build一个macros，其中用户将在一张表中select（标记/取消标记）字段名称，运行macros将重新sorting，格式化另一张纸上的数据，并删除用户不想看到的列。

例如：用户希望看到列数据元素A，B和D，但不是C，所以他们标记在表一中的三行，并保留dataC空白。

Sheet1 Field Name(Column A) Include? (Column B) DataA Y DataB DataC Y DataD Y 

macros运行并创build一个sheet2，它保留了标准导出文件的所有字段…目前有50多个字段，但是对于这个例子，可以说只有4个字段

理想情况下，结果将是仅包含以下列的工作表2。

 DataA DataB DataC 

我已经创build了一个格式化的macros。 有什么我可以添加到最后删除某些列基于Sheet1的信息？

任何和所有的帮助将不胜感激。

谢谢！

——————-这是我想巩固的一大堆，因此我的问题。 而不是试图维护不同的macros，并要求人们从源系统的某些领域出口，我认为这将是更容易的自动出口数据，人们只需标记他们需要和运行macros。 谢谢

 Sub ARMImport() ' ' Upload1 Macro ' ' Dim FileToOpen FileToOpen = Application.GetOpenFilename If FileToOpen <> False Then Workbooks.OpenText FileToOpen, Origin:= _ 65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, Comma:=True, _ Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _ 3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10 _ , 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _ Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array( _ 23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), _ Array(30, 1), Array(31, 1)), TrailingMinusNumbers:=True Else MsgBox "No file selected. Macro cancelled." Exit Sub End If ActiveWorkbook.Unprotect ("deleted") ActiveSheet.Unprotect ("deleted") Rows(Range("J" & Rows.Count).End(xlUp).Row + 1 & ":" & Rows.Count).Delete Columns("K:JA").Select Selection.Delete Shift:=xlToLeft Range("J8").Activate With Selection.Validation .Delete .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _ :=xlBetween .IgnoreBlank = True .InCellDropdown = True .ShowInput = True .ShowError = True End With Columns("H:J").Select Range("J8").Activate With Selection.Validation .Delete .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _ :=xlBetween .IgnoreBlank = True .InCellDropdown = True .ShowInput = True .ShowError = True End With Range("K8").Select ActiveCell.FormulaR1C1 = "#" With ActiveCell.Characters(Start:=1, Length:=1).Font .Name = "Calibri" .FontStyle = "Bold" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontMinor End With Range("L8").Select ActiveCell.FormulaR1C1 = "Entered By" & vbCrLf & "(f_boX.entered_by)" Range("E4").Select Selection.Copy Range("L9").Select ActiveSheet.Paste Range("M8").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Box Status" & vbCrLf & "(f_box.status)" Application.CutCopyMode = False Range("M9").Select ActiveCell.FormulaR1C1 = "A" Range("M10").Select Range("K9").Value = InputBox("redacted question?") Dim LR As Long LR = Range("J" & Rows.Count).End(xlUp).Row Range("L9:M9").Select Selection.Copy Range("L9:M" & LR).Select ActiveSheet.Paste LRZ = Range("J" & Rows.Count).End(xlUp).Row Range("K9").Select Selection.AutoFill Destination:=Range("K9:K" & LRZ), Type:=xlFillSeries Rows("1:8").Select Range("A8").Activate Selection.Delete Shift:=xlUp Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A1").Select ActiveCell.FormulaR1C1 = "Vendor Barcode" & vbCrLf & "(f_box.external_name)" Range("B1").Select ActiveCell.FormulaR1C1 = "User Box Number" & vbCrLf & "(f_box.cust_user_box_number)" Range("C1").Select ActiveCell.FormulaR1C1 = "Department" & vbCrLf & "(f_box.office_id)" Range("D1").Select ActiveCell.FormulaR1C1 = "Description" & vbCrLf & "(f_box.notes)" With ActiveCell.Characters(Start:=1, Length:=11).Font .Name = "Calibri" .FontStyle = "Regular" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontMinor End With Range("E1").Select ActiveCell.FormulaR1C1 = "additional Description" & vbCrLf & "(f_box.notes2)" With ActiveCell.Characters(Start:=1, Length:=22).Font .Name = "Calibri" .FontStyle = "Regular" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontMinor End With Range("F1").Select ActiveCell.FormulaR1C1 = "From Date" & vbCrLf & "(f_box.cust_from_date)" Range("G1").Select ActiveCell.FormulaR1C1 = "To Date" & vbCrLf & "(f_box.cust_to_date)" Range("H1").Select ActiveCell.FormulaR1C1 = "Box Type" & vbCrLf & "(f_box.box_type)" Range("I1").Select ActiveCell.FormulaR1C1 = "Media Type" & vbCrLf & "(f_box.cust_media_type)" With ActiveCell.Characters(Start:=1, Length:=10).Font .Name = "Calibri" .FontStyle = "Regular" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontMinor End With Range("J1").Select ActiveCell.FormulaR1C1 = "Category" & vbCrLf & "(category_import_id [fullcode] )" Range("K1").Select ActiveCell.FormulaR1C1 = "#" Range("L1").Select ActiveCell.FormulaR1C1 = "BoX owner" & vbCrLf & "(f_boX.owner )" Range("M1").Select ActiveCell.FormulaR1C1 = "Box Status" & vbCrLf & "(f_box.status)" Columns("K:K").Select Selection.Cut Columns("A:A").Select Selection.Insert Shift:=xlToRight Columns("L:L").Select Selection.Copy Columns("B:B").Select Selection.Insert Shift:=xlToRight Range("B1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Entered By" & vbCrLf & "(f_boX.entered_by)" Columns("A:A").Select Selection.Copy Columns("C:C").Select Selection.Insert Shift:=xlToRight Range("C1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Box Number" & vbCrLf & "f_box.box_num" Columns("D:D").Select Selection.Copy Columns("G:G").Select Selection.Insert Shift:=xlToRight Range("G1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Foreign Barcode" & vbCrLf & "(Barcode)" Columns("P:P").Select Selection.Cut Columns("H:H").Select Selection.Insert Shift:=xlToRight Cells.Select With Selection .HorizontalAlignment = xlCenter .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection.Font .ColorIndex = xlAutomatic .TintAndShade = 0 End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Rows("1:1").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Font.Bold = True Dim LRF As Long LRF = Range("A" & Rows.Count).End(xlUp).Row Range("A1:P" & LRF).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Columns("P:P").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("P1").Select ActiveCell.FormulaR1C1 = "Storage Location" & vbCrLf & "(f_box.warehouse_id)" With ActiveCell.Characters(Start:=1, Length:=16).Font .Name = "Calibri" .FontStyle = "Bold" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontMinor End With Range("P2").Value = InputBox("redacted question?") Dim LRST As Long LRST = Range("A" & Rows.Count).End(xlUp).Row Range("P2").Select Selection.AutoFill Destination:=Range("P2:P" & LRST) Range("F2").Value = InputBox("What is the Department ID?") Dim LRDI LRDI = Range("A" & Rows.Count).End(xlUp).Row Range("F2").Select Selection.AutoFill Destination:=Range("F2:F" & LRDI) Sheets("Retention Schedule").Select Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Sheets("Instructions").Select Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Rows("2:8").Select Selection.Delete Shift:=xlUp Range("A2").Select MsgBox "Macro Completed" End Sub