扩展列表和更新公式

Question

我有一张excel有多张表格，想要复制或者更好地说想要每个月延长最后一栏。

如： - 我有一张名为sheet1，sheet2，sheet3，sheet4，sheet5的工作表......月底的每张工作表都有公式。一个月结束我想添加一个新月的新列并复制现有的新列的公式。让我说我上个月1月，我需要VBA添加月份为2月的新列，并将所有公式复制到新列。

有时我还需要复制多个列（例如：-Column C-J）并使用新月和公式复制下一个8列。

尝试使用录制宏但问题是它没有为每个月创建一个新列，只是将其粘贴到同一列而不是每月创建一个新列

Answer 1

如果不看公式，很难理解这个问题。

听起来你可以从使用自动填充开始。您可以通过选择要复制的范围并在右下角拖动十字来手动执行此操作。这将自动更新月份。

您可以使用VBA实现此目的，例如：

Public Sub copyRange()
    Dim rngSource As Range
    Dim rngDestination As Range

    rngSource = ActiveSheet.Range("A1:A20")
    rngDestination = ActiveSheet.Range("B1:B20")

    rngSource.AutoFill Destination:=rngDestination
End Sub

无论哪种方式，我都无法告诉您如何在不看单元格代码的情况下重置新月的公式。

更新：要在多个标签上自动填充多列

Public Sub copySpecifiedColumns()
    copyRanges InputBox("How many columns do you wish to copy?", "Copy Columns", "1")
End Sub
Private Sub copyRanges(copyCols As Byte)
    Dim ws As Worksheet, lastCol As Integer, lastRow As Integer
    Dim rngSource As Range, rngDestination As Range
    Dim sheetList As Variant
    sheetList = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")

    For Each ws In ThisWorkbook.Sheets
        If (UBound(Filter(sheetList, ws.Name)) > -1) Then
            lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            Set rngSource = ws.Range(ws.Cells(1, lastCol - copyCols + 1), _
                ws.Cells(lastRow, lastCol))
            Set rngDestination = ws.Range(ws.Cells(1, lastCol - copyCols + 1), _
                ws.Cells(lastRow, lastCol + copyCols))

            rngSource.AutoFill rngDestination
        End If
    Next ws
End Sub

Answer 2

我同意有点难以理解你想要在这里实现的目标。根据我的理解，如果你想在每张工作表的下一列中复制最后一列，并将该列的第一个单元格更改为当时的月份。这段代码可以提供帮助。

Sub copy_col()


Dim lColumn As Long
For Each Sheet In Worksheets

lColumn = Sheet.Cells(1, Columns.Count).End(xlToLeft).Column
Sheet.Columns(lColumn).Copy Sheet.Columns(lColumn + 1)
Sheet.Cells(1, lColumn + 1).Value = Month(Now())

Next Sheet
End Sub

如果这不是您想要的，请更简要地解释一下您的问题。

由于

Answer 3

扩展列表和更新公式

<强>用法

ExtendList 5，＆＃34; Sheet1＆＃34;，＆＃34; Sheet3＆＃34;

其中 1. 5，是要复制到下一个空列的列 2.＆＃34; Sheet1＆＃34;是原始公式中引用的工作表 3.＆＃34; Sheet3＆＃34;是替换表名称

原始公式

= Sheet 1中！$ A10

新公式

=表Sheet 3！$ A10

＆＃13;

Sub ExtendList(SourceColumn As Long, OriginalSheetName As String, NewSheetName As String)
    On Error Resume Next
    Dim newColumnNumber As Integer
    Worksheets(NewSheetName).Name = NewSheetName
    If Err.Number <> 0 Then
        Err.Clear
        Exit Sub
    End If
    On Error GoTo 0
    
    newColumnNumber = Range(Cells(1, Columns.Count), Cells(Rows.Count, Columns.Count)).End(xlToLeft).Offset(, 1).Column

    Columns(SourceColumn).Copy Columns(newColumnNumber)
    
    Columns(newColumnNumber).Replace What:=OriginalSheetName, Replacement:=NewSheetName, lookat:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False

End Sub

＆＃13;

仅当列引用为绝对值时才会起作用：

正确

$ A1或$ A $ 2

不正确

A1或A $ 1

使用公式为新工作表创建多个工作表和复制粘贴的VBA

3 个答案:

扩展列表和更新公式

仅当列引用为绝对值时才会起作用：