Скопируйте несколько листов из одной книги в новую, но скопируйте значения, а не формулы.Затем сохраните в текущем каталоге как сегодняшнюю дату - PullRequest
0 голосов
/ 24 мая 2019

У меня есть книга, которая содержит более 20 листов, я пытаюсь создать макрос, который при запуске скопирует 3 конкретных листа в новую книгу, но со значениями в месте назначения вместо формул и сохранит ее каксегодняшние дата и время, если предпочтительнее.

Мне удалось сделать несколько попыток сделать это по-разному, но независимо от того, каким образом у меня всегда возникают проблемы с его успешной работой.Наиболее согласованным является следующий код:

Sub CopyInNewWB()
Dim wbO As Workbook, wbN As Workbook

On Error GoTo ErrHandler

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Set wbO = ActiveWorkbook
Set wbN = Workbooks.Add

wbO.sheets("Tracking").Copy wbN.sheets(1)
wbO.sheets("Bridge").Copy wbN.sheets(2)
wbO.sheets("Overview (Age)").Copy wbN.sheets(3)

wbN.sheets("Sheet1").Delete
wbN.sheets("Customers").Activate

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True

ErrHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True


End Sub

Это работает, так как создает новую рабочую книгу и копирует эти предполагаемые листы, но копирует формулы и ссылается на исходную рабочую книгу, к которой они пришли.от.Также независимо от того, что я добавляю в конец, он не будет сохранен как что-либо, кроме «Book1».В идеале он будет сохраняться в том же каталоге, что и рабочая книга, из которой он получен.

1 Ответ

0 голосов
/ 24 мая 2019

попробуйте

 Sub CopyInNewWB()
    Dim wbO As Workbook, wbN As Workbook

    On Error GoTo ErrHandler

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    Set wbO = ActiveWorkbook
    Set wbN = Workbooks.Add

    wbO.Sheets("Tracking").Copy wbN.Sheets(1)

    'just a trick to "copy/paste" values
    With ActiveSheet.UsedRange
       .Value = .Value
    End With

    wbO.Sheets("Bridge").Copy wbN.Sheets(2)
    wbO.Sheets("Overview (Age)").Copy wbN.Sheets(3)

    wbN.Sheets("Sheet1").Delete
    wbN.Sheets("Customers").Activate

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True

ErrHandler:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True


End Sub

ты должен добавить

With ActiveSheet.UsedRange
   .Value = .Value
End With

каждый раз, когда вы копируете лист

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...