#excel #vba
Вопрос:
Мне нужно скопировать данные из (источника) Рабочая тетрадь в (пункт назначения) Рабочая книга с предварительно созданными существующими листами в целевой книге. Мне нужен код для циклического просмотра листов в исходном файле, копирования и вставки значений в указанные листы в пункте назначения. Есть более 100 листов, для которых это потребуется сделать.
Я нашел этот код в Интернете и пытаюсь изменить его в соответствии со своими потребностями. Проблема в том, что листы создаются после существующих листов, и мне нужно, чтобы данные были скопированы на уже существующие листы.
Sub CopyWorkbook() Dim sh As Worksheet, wb As Workbook Set wb = Workbooks("Destination.xlsm") For Each sh in Workbooks("Origin.xlsm") sh.Copy After:=wb.Sheets(wb.Sheets.Count) Next sh End Sub Любая помощь будет очень признательна.
Комментарии:
1. Что связывает исходный лист с целевым листом, совпадают ли имена ?
2. Здравствуйте, я новичок в макросах, но я сделаю все возможное, чтобы ответить на этот вопрос. В исходной книге содержится много листов, которые необходимо вставить в целевую книгу. Т. е.: Исходный лист 1 должен быть вставлен в лист назначения 1, Исходный лист 2 должен быть вставлен в лист назначения 2, и так далее, и так далее, пока все листы не будут скопированы и вставлены.
3. Попробуй
sh.Cells.Copy Destination:=wb.Sheets(sh.Index).Range("A1").4. Это именно то, что мне было нужно. Большое спасибо!
5. Знаете ли вы, как освободить некоторые рабочие листы от выполнения в этом коде?
Ответ №1:
Скопируйте листы в другую книгу
- Следующие действия приведут к удалению существующих целевых листов и замене их новыми версиями исходных листов. Если исходный лист не существует в целевой книге, он будет скопирован в последнюю позицию.
Option Explicit Sub CopySheets() Const ProcTitle As String = "Copy Sheets" Const sExceptionsList As String = "Sheet1,Sheet2" Const dFilePath As String = "C:Test202169957615Destination.xlsm" Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code Dim sExceptions() As String: sExceptions = Split(sExceptionsList, ",") Dim sshCount As Long: sshCount = swb.Sheets.Count Dim sshNames() As String: ReDim sshNames(1 To sshCount) Dim ssh As Object Dim sshName As String Dim dIndex As Long Dim n As Long ' Write the Source Sheet Names to an array. For Each ssh In swb.Sheets sshName = ssh.Name If IsError(Application.Match(sshName, sExceptions, 0)) Then n = n 1 sshNames(n) = sshName End If Next ssh If n lt; sshCount Then sshCount = n ReDim Preserve sshNames(1 To sshCount) End If Dim dwb As Workbook: Set dwb = Workbooks.Open(dFilePath) Dim dshCount As Long: dshCount = dwb.Sheets.Count Dim dsh As Object Application.ScreenUpdating = False For n = 1 To sshCount sshName = sshNames(n) Set ssh = swb.Sheets(sshName) On Error Resume Next Set dsh = dwb.Sheets(sshName) On Error GoTo 0 If dsh Is Nothing Then ' copy new sheet ssh.Copy After:=dwb.Sheets(dwb.Sheets.Count) dshCount = dshCount 1 Else ' copy existing sheet dIndex = dsh.Index Application.DisplayAlerts = False dsh.Delete Application.DisplayAlerts = True If dIndex = dshCount Then ssh.Copy After:=dwb.Sheets(dIndex - 1) Else ssh.Copy Before:=dwb.Sheets(dIndex) End If End If Set dsh = Nothing Next n Application.ScreenUpdating = True MsgBox "Sheets copied.", vbInformation, ProcTitle End Sub