为多个工作表创建VBA，并使用公式将粘贴复制到新列中

Question

我有一个具有多个工作表的excel，并且想要复制或更好地说要每月扩展最后一列。

例如：-我有一个工作表，其工作表名为sheet1，sheet2，sheet3，sheet4，sheet5 ...每个月底的工作表都有公式。将现有公式复制到新列中。假设我上个月是Jan，我需要VBA添加月份为Feb的新列并将所有公式复制到新列中。

有时我还需要复制多列（例如：-CJ列），并用新的月份和公式复制下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，“ Sheet1”，“ Sheet3”

其中1、5是要复制到下一个空列的列2。“ Sheet1”是原始公式3中引用的工作表。“ Sheet3”是替换工作表的名称

原始配方

= Sheet1！$ A10

新配方

= Sheet3！$ A10

 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 

仅当列引用是绝对的时，这才起作用：

正确

$ A1或$ A $ 2

不正确的

A1或A $ 1