Question

我有这个代码，我需要简化，否则我将至少复制它十二次，以涵盖可能不会优化的一年中的几个月。我不太清楚如何去做这件事。

Sub Test_Copy()

    Dim rng As Range
    Dim lastRow As Long
    With Worksheets("Sheet1")
        Set rng = .Range("B3", .Range("B" & .Rows.Count).End(xlUp))
    End With
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Rows(lastRow).Select
    With Worksheets("Mai")
        Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
        Worksheets("Mai").Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
    End With
    With Worksheets("Juin")
        Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
        Worksheets("Juin").Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
    End With
    With Worksheets("Juil")
        Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
        Worksheets("Juil").Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
    End With

End Sub

Answer 1

首先，您错误地使用了With。

With Worksheets("Juin")
    Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
    Worksheets("Juin").Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
End With

你会像这样使用它：

With Worksheets("Juin")
    .Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
    .Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
End With

以.开头的任何内容都会自动违反您设置为With的内容。我不确定你是否想做选择，我想你需要先做一个选择，但是在插入行之前你没有说明要选择什么。

但是，除了这些问题之外，这会做你想要的（但你仍然需要修复With的选择部分。

Sub Test_Copy()
    Dim rng As Range, lastRow As Long, MyMonth As Variant
    MyMonth = Array("Mai", "Juin", "Juil") ' Put more months in here
    Set rng = Worksheets("Sheet1").Range("B3", .Range("B" & .Rows.Count).End(xlUp))
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Rows(lastRow).Select 'I "think" you want to do something with this for selecting within the sheet BUT lastrow is relevant only to the data in Sheet1
    For X = LBound(MyMonth) To UBound(MyMonth)
        With Worksheets(MyMonth(X))
            .Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
            .Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
        End With
    Next
End Sub

但是，如果您不需要选择一个单元格并插入，那么您也可以删除它，并最终得到：

Sub Test_Copy()
    Dim rng As Range, lastRow As Long, MyMonth As Variant
    MyMonth = Array("Mai", "Juin", "Juil") ' Put more months in here
    Set rng = Worksheets("Sheet1").Range("B3", .Range("B" & .Rows.Count).End(xlUp))
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Rows(lastRow).Select 'I "think" you want to do something with this for selecting within the sheet BUT lastrow is relevant only to the data in Sheet1
    For X = LBound(MyMonth) To UBound(MyMonth)
        Worksheets(MyMonth(X)).Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
    Next
End Sub

这不会插入任何内容，只需从单元格B6向上写入任何内容的顶部。

编辑你的上一条评论：

Sub Test_Copy()
    Dim rng As Range, MyMonth As Variant
    MyMonth = Array("Mai", "Juin", "Juil") ' Put more months in here
    Set rng = Sheets("Sheet1").Range("B3", .Range("B" & .Rows.Count).End(xlUp))
    For X = LBound(MyMonth) To UBound(MyMonth)
        Sheets(MyMonth(X)).Range("A" & .Cells(Rows.Count, 2).End(xlUp).Row).Resize(rng.Rows.Count, 1).EntireRow.Insert
        Sheets(MyMonth(X)).Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
    Next
End Sub

最后，还有另一种可能性，我没有使用我在代码中构建的工作表数组，你可以使用For each WS in Worksheets使用工作表对象，然后你可以使用WS.blahblah来操作工作表但你会需要在那里进行测试以确保您没有按下您正在复制的工作表。无论哪种方式在技术上都是可以接受的。

该代码看起来像这样：

Sub Test_CopyWS()
    Dim rng As Range, WS As Worksheet
    Set rng = Sheets("Sheet1").Range("B3", .Range("B" & .Rows.Count).End(xlUp))
    For Each WS In Worksheets
        If Not ES.name = "Sheet1" Then
            WS.Range("A" & .Cells(Rows.Count, 2).End(xlUp).Row).Resize(rng.Rows.Count, 1).EntireRow.Insert
            WS.Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
        End If
    Next
End Sub

代码简化以涵盖所有12个工作表

1 个答案: