时间戳

首页 > 解决方案 > 格式化工作表 5 及更高版本，然后将该信息复制并粘贴到具有源宽度和格式的“Sheet3”中

excel - 格式化工作表 5 及更高版本，然后将该信息复制并粘贴到具有源宽度和格式的“Sheet3”中

问题描述

我目前正在尝试制作一个代码，它将格式化工作表 5 并将其转换为模块代码，然后让程序复制每个新格式化的工作表中的所有信息，并将它们粘贴到具有原始宽度和格式的“工作表 3”中。

我已经尝试过“for each”和“integer”函数，但似乎无法让“程序移过“sheet5”。

这个 sub 应该通过所有的工作表并“根据我的需要格式化它们：

Sub TEST2()
    Dim ws As Worksheet
    Dim wsDest As Worksheet
    Dim LastRow As Long

    Set wsDest = Sheets("sheet3")
    For Each ws In ActiveWorkbook.Sheets
        If ws.Name <> wsDest.Name And _
           ws.Name <> "sheet1" And _
           ws.Name <> "sheet2" And _
           ws.Name <> "sheet4" Then
            'code here
            Columns.Range("A:A,B:B,H:H,I:I").Delete
            Columns("A").ColumnWidth = 12
            Columns("B").ColumnWidth = 17
            Columns("C").ColumnWidth = 10
            Columns("D").ColumnWidth = 85
            Columns("E").ColumnWidth = 17
            ActiveSheet.Range("D:D").WrapText = True
            ActiveSheet.Range("F:F").EntireColumn.Insert
            ActiveSheet.Range("F1").Formula = "Product ID"
            LastRow = Cells(Rows.Count, 1).End(xlUp).Row
            Range("F2:F" & LastRow).Formula = "=$G$2"
            ActiveSheet.Range("F2").Copy
            Range("F2:F" & LastRow).PasteSpecial Paste:=xlPasteValues
        End If
    Next ws
End Sub

该子程序首先要转到“sheet5”并将其粘贴到“sheet3”中，然后子程序的后半部分应从“sheet6”开始并继续“直到工作表的末尾，然后复制并粘贴到"sheet3" 与 '原始宽度。

Sub Test1()
    Dim sht As Worksheet
    Dim LastRow As Long
    Dim WS_Count As Integer
    Dim I As Integer

    Sheets("Sheet5").Select
    Application.CutCopyMode = False
    Application.Run "PERSONAL.XLSB!Module1.Del_move_insert_colmuns"
    Range("G2").Select
    ActiveCell.Offset(0, -1).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Range("A1").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                           SkipBlanks:=False, Transpose:=False
    ActiveSheet.Range("D:D").WrapText = True

    WS_Count = ActiveWorkbook.Worksheets.Count
    ' Begin the loop
    For I = 5 To WS_Count
        'code here
        Sheets("Sheet6").Select
        Application.Run "PERSONAL.XLSB!Module1.Del_move_insert_colmuns"
        Application.CutCopyMode = False
        Range("G2").Select
        ActiveCell.Offset(0, -1).Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToLeft)).SelectApplication.CutCopyMode = False
        Selection.Copy
        Sheets("Sheet3").Select
        Range("A1").Select
        'crtl shift + down
        Selection.End(xlDown).Select
        'moves down one cell to paste
        ActiveCell.Offset(1, 0).Select
        ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                               SkipBlanks:=False, Transpose:=False

    Next I

End Sub

我现在得到的是它可以很好地执行“sheet5”和“sheet6”，但是在那之后没有格式化并且在工作表上我得到的只是一堆顶部标记为产品 ID 的列和一堆 0。

标签： excelvbacopy-paste

解决方案

您的问题的很大一部分是您的大部分代码“假设”您在真正使用ActiveSheet. 作为例程中的示例TEST2，您正在循环浏览工作簿中的所有工作表，跳过某些工作表。这部分工作正常。但是，当您想格式化其他工作表时，您实际上只使用当前处于活动状态的任何工作表。要解决此问题，您应该养成确保所有Worksheet、Range和Cells参考始终完全合格的习惯。那么你的代码是这样工作的：

ws.Columns.Range("A:A,B:B,H:H,I:I").Delete
ws.Columns("A").ColumnWidth = 12
ws.Columns("B").ColumnWidth = 17
ws.Columns("C").ColumnWidth = 10
ws.Columns("D").ColumnWidth = 85
ws.Columns("E").ColumnWidth = 17
ws.Range("D:D").WrapText = True
ws.Range("F:F").EntireColumn.Insert
ws.Range("F1").Formula = "Product ID"
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
ws.Range("F2:F" & LastRow).Formula = "=$G$2"
ws.Range("F2").Copy
ws.Range("F2:F" & LastRow).PasteSpecial Paste:=xlPasteValues

注意每个引用是如何锁定到同一个工作表的。With不过，您可以使用该语句走捷径。但是您必须确保每个引用.前面都有 以将其锁定回With对象，如下所示：

With ws
    .Columns.Range("A:A,B:B,H:H,I:I").Delete
    .Columns("A").ColumnWidth = 12
    .Columns("B").ColumnWidth = 17
    .Columns("C").ColumnWidth = 10
    .Columns("D").ColumnWidth = 85
    .Columns("E").ColumnWidth = 17
    .Range("D:D").WrapText = True
    .Range("F:F").EntireColumn.Insert
    .Range("F1").Formula = "Product ID"
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("F2:F" & LastRow).Formula = "=$G$2"
    .Range("F2").Copy
    .Range("F2:F" & LastRow).PasteSpecial Paste:=xlPasteValues
End With

对于您的其余代码，您可以通过避免使用Select和Activate来进行改进。还要考虑本文中讨论的技巧，这些技巧将为您提供出色的指导。

推荐阅读