excel - 将列移动到新工作表excel VBA
问题描述
因此,我有一张包含信息的表格(大约 200 列),我想将其移至新表格。这个想法是我需要在每个新工作表中的 A 列,然后是 B 列,然后下一张表再次列 A + C 列,依此类推,直到最后一列。有人可以帮我解决这个问题吗?
Sub copyColumns()
Columns("A:B").Select
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
Sheets("Sheet1").Select
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Columns("C:C").Select
ActiveSheet.Paste
Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Select
Range("A:B,D:D").Select
Range("D1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet5").Select
ActiveSheet.Paste
End Sub
解决方案
复制列
- 以下将复制列然后
A,B,C
...等每个到一个新的工作表。A,B,D
A,B,E
Option Explicit
Sub copyColumns()
Const sName As String = "Sheet1"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
' Define Last column.
Dim sLast As Long
sLast = sws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
Application.ScreenUpdating = False
' Add worksheets.
Dim n As Long
For n = 3 To sLast
With wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
Union(sws.Columns("A:B"), sws.Columns(n)).Copy .Columns("A")
End With
Next n
' Delete columns.
'sws.Columns(3).Resize(, sLast - 2).Delete (- 3 + 1 = - 2)
Application.ScreenUpdating = False
End Sub
- 添加(处理)这么多工作表时,如果出现问题,您可能希望能够轻松删除它们:
Sub deleteWorksheetsExcept()
Const ProcName As String = "deleteWorksheetsExcept"
On Error GoTo clearError
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim arr As Variant: ReDim arr(1 To wb.Worksheets.Count)
Dim ws As Worksheet
Dim n As Long
For Each ws In wb.Worksheets
Select Case ws.Name ' add/remove exact names from the following list:
Case "Sheet1", "Sheet2", "Sheet3" ' worksheets to keep
Case Else
n = n + 1
arr(n) = ws.Name
End Select
Next ws
If n > 0 Then
ReDim Preserve arr(1 To n)
Application.DisplayAlerts = False
wb.Worksheets(arr).Delete
Application.DisplayAlerts = True
End If
ProcExit:
Exit Sub
clearError:
Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
& " " & "Run-time error '" & Err.Number & "':" & vbLf _
& " " & Err.Description
Resume ProcExit
End Sub
推荐阅读
- javascript - 如何在node js中为数据库应用程序同步编写代码
- vuejs2 - vue信用卡组件
- c# - 绑定命令的正确方法
- python - python numpy数组的嵌套循环
- php - PHP:如果没有赋值,为什么会修改值?
- python - 尝试在当前文件中添加 python 文件时出错
- php - 非法字符串偏移警告 nav-menu.php
- mysql - 我应该索引具有以下两个选项之一的字段:无符号、唯一(mysql)吗?
- javascript - Express.js CRUD 应用程序错误:更新函数执行错误重定向
- jenkins - 这真的是 JUnit 报告文件吗?.Json 文件的 Jenkins 错误