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

Question

I have an excel with multiple sheets and would like to copy or better say want to extend the last column every month.

Eg:- I have a sheet with sheet named sheet1,sheet2,sheet3,sheet4,sheet5...every sheet at the end of the month has formulas.Once a month is over I would like to add a new column with new month and copying the existing formula to the new column.Let say I have last month Jan and I need VBA to add new column with month as Feb and copy all the formula to the new column.

Sometimes I also need to copy multiple column (eg:-Column CJ) and replicate the next 8 column with new month and formula.

Tried with recording macro but the issue is it doesn't create a new column for every month it just copy paste it in same column rather than creating a new one for every month

Answer 1

It is difficult to understand the problem without seeing the formulas.

It sounds like you could start by using the AutoFill. You could do this manually by selecting the range you want to copy and dragging the cross in the bottom right corner. This will update the month automatically.

You can achieve this with VBA, such as:

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

Either way, I can't tell how to reset the formulae for the new months without seeing the cell code.

UPDATE: To AutoFill multiple columns on multiple tabs

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

I Agree it's a bit difficult to understand what you are trying to achieve here. From what I understand if you want to make a copy of last column in the next column in each sheet and change the 1st cell of that column to the month at the time. This code can help.

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

If this is not what you want then please explain your problem more briefly.

Thanks

Answer 3

Extend List and Update Formula

Usage

ExtendList 5, "Sheet1", "Sheet3"

Where 1. 5, is the Column to Duplicate to the next empty Column 2. "Sheet1" is the sheet referenced in the original formula 3. "Sheet3" is the replace sheet name

Original Formula

=Sheet1!$A10

New Formula

=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 

This will only work if the column reference is absolute:

Correct

$A1 or $A$2

Incorrect

A1 or A$1