為多個工作表創建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