Скопировать столбец или столбцы из каждого листа в одном листе с помощью VBA в Microsoft Excel
Иногда копирование данных с нескольких листов в один столбец становится рутинной работой. Этого шага можно избежать с помощью автоматизации. Если вы хотите создать сводный лист после копирования данных из столбца каждого листа на один лист, вам следует прочитать эту статью.
В этой статье мы создадим макрос для копирования данных из определенного столбца и вставки на новый лист.
Исходные данные для этого примера состоят из данных о сотрудниках в форме книги Excel, содержащей три листа с ведомственными, личными и контактными данными сотрудников.
Для копирования данных с разных листов на новый лист мы создали макрос «CopyColumns». Этот макрос можно запустить, нажав кнопку «Запустить макрос» на листе «Основные».
Макрос CopyColumns вставит новый лист с именем «Master» после листа «Main». «Мастер» будет содержать сводные данные со всех листов.
Объяснение кода
Worksheets.Add (after: = Worksheets («Main»))
Приведенный выше код используется для вставки новых рабочих листов после «Основного» рабочего листа.
Если Source.Name <> «Master» и Source.Name <> «Main», то End If Above используется для ограничения копирования данных с «Master» и «Main» листов.
Source.UsedRange.Copy Destination.Columns (Last)
Приведенный выше код используется для копирования данных из исходного листа в целевой лист.
Для каждого источника в ThisWorkbook.Worksheets Если Source.Name = «Master», то MsgBox «Мастер-лист уже существует»
Exit Sub End If Next Above code используется для проверки, существует ли уже «мастер» лист в книге. Макрос остановит выполнение, если «Мастер» лист уже существует в книге.
Пожалуйста, введите код ниже
Option Explicit
Sub CopyColumns()
Dim Source As Worksheet
Dim Destination As Worksheet
Dim Last As Long
Application.ScreenUpdating = False
'Checking whether "Master" sheet already exists in the workbook
For Each Source In ThisWorkbook.Worksheets
If Source.Name = "Master" Then
MsgBox "Master sheet already exist"
Exit Sub
End If
Next
'Inserting new worksheets in the workbook
Set Destination = Worksheets.Add(after:=Worksheets("Main"))
'Renaming the worksheet
Destination.Name = "Master"
'Looping through the worksheets in the workbook
For Each Source In ThisWorkbook.Worksheets
If Source.Name <> "Master" And Source.Name <> "Main" Then
'Finding the last column from the destination sheet
Last = Destination.Range("A1").SpecialCells(xlCellTypeLastCell).Column
If Last = 1 Then
'Pasting the data in the destination sheet
Source.UsedRange.Copy Destination.Columns(Last)
Else
Source.UsedRange.Copy Destination.Columns(Last + 1)
End If
End If
Next
Columns.AutoFit
Application.ScreenUpdating = True
End Sub
Если вам понравился этот блог, поделитесь им с друзьями на Facebook и Facebook.
Мы будем рады услышать от вас, дайте нам знать, как мы можем улучшить нашу работу и сделать ее лучше для вас. Напишите нам на [email protected]