Макрос копирования строки на все листы в excel - Word и Excel

desbane

Пользователь

Сообщений: 9
Регистрация: 25.09.2017

Добрый день, подскажите как можно реализовать макрос, который будет из таблицы копировать строки на другие листы этой книги,строки за определённую дату на определённый лист. Допустим, чтобы строки таблицы за 01.09.2017 копировались в лист 01, за 02.09.2017 в лист 02 и.т.д

Прикрепленные файлы

primer.xlsx (14.54 КБ)

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

25.09.2017 14:54:28

Цитата
как можно реализовать макрос

Ставите автофильтр по дате, копируете видимые строки на соответствующий лист

desbane Пользователь Сообщений: 9 Регистрация: 25.09.2017	Необходимо чтобы по нажатию кнопки это автоматом делалось, на все листы.Без ручного копирования. Цель, чтобы из общей таблицы создавался отчёт по дням со строками на каждом листе по дате. Изменено: desbane — 25.09.2017 15:12:09

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

Я вам и написал алгоритм решения вашей задачи.
1. Выделить из колонки с датами уникальные значения
2. цикл по этим уникальным значениям дат
3. для каждой даты применяете автофильтр и видимый диапазон копируете на соответствующий лист
Кнопочку на Лист1 и к ней привязать макрос.

desbane Пользователь Сообщений: 9 Регистрация: 25.09.2017	«3. для каждой даты применяете автофильтр и видимый диапазон копируете на соответствующий лист .» — как это в макросе описать, не понимаю, если можете подробней объясните.Спасибо.

Kuzmich Пользователь Сообщений: 7998 Регистрация: 21.12.2012	Предполагается, что в книге всегда есть соответствующий дате лист? Или надо его создавать?

tolstak

Пользователь

Сообщений: 471
Регистрация: 01.08.2017

25.09.2017 17:52:29

desbane, проверяйте.

Код

Sub copyToLists()
    Sheets("ЛИСТ1").Activate
    Dim copyRn As Range, dataWs As Worksheet, copySh As Worksheet
    Set copyRn = [A1:E25]
    Set dataWs = ActiveSheet
    dataWs.AutoFilterMode = False
    Dim uniqueDatesDic As Object
    Set uniqueDatesDic = CreateObject("Scripting.Dictionary")
    shNums = 1
    For i = 2 To copyRn.Columns(1).Cells.Count
        Set el = copyRn.Cells(i, 1)
        If Not uniqueDatesDic.Exists(el.Value) Then
            copyRn.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria1:=el.Value
            Set copySh = SheetRequired(Format(shNums, "00"), True)
            copyRn.SpecialCells(xlCellTypeVisible).Copy Destination:=copySh.Range("A1")
            copySh.Cells.EntireColumn.AutoFit
            copySh.Move after:=Sheets(shNums)
            shNums = shNums + 1
            uniqueDatesDic.Add Key:=el.Value, Item:=shNums
            dataWs.AutoFilter.ShowAllData
        End If
    Next i
    dataWs.Activate
    dataWs.AutoFilterMode = False
End Sub


Function SheetRequired(SheetName As String, Optional needToClear As Boolean = False) As Object
    Dim curList As Object, SheetToReturn As Object
    Dim SheetNameEscaped As String
    Set curList = ActiveSheet
    SheetNameEscaped = SheetName
    If SheetExists(SheetNameEscaped) = True Then
        Sheets(SheetNameEscaped).Activate
    Else
        Sheets.Add
        ActiveSheet.name = SheetNameEscaped
    End If
    Set SheetToReturn = ActiveSheet
    
    If needToClear = True Then ActiveSheet.Cells.Delete
    curList.Select
    Set SheetRequired = SheetToReturn
End Function

Function SheetExists(name As String) As Boolean
    Dim SheetNameEscaped As String
    On Error GoTo ShNotFound
    If Sheets(name).name <> "" Then SheetExists = True
    Exit Function
ShNotFound:
    SheetExists = False
End Function

Прикрепленные файлы

primer.xlsm (29.9 КБ)

In GoTo we trust

desbane

Пользователь

Сообщений: 9
Регистрация: 25.09.2017

Предполагается что всегда есть листы, 01,02…..31. Дни в таблицу будут добавляться. Чтот не работает макрос, копирует только шапку таблицы. Если дату изменить например на 10е число, то в лист 10 ничего не копируется. Мож у меня с excelем что не так.?

Изменено: desbane — 25.09.2017 19:17:35

tolstak

Пользователь

Сообщений: 471
Регистрация: 01.08.2017

25.09.2017 19:45:03

desbane, нет, с Excel’ем, думаю, все нормально..
Попробуйте так:

Код

Sub copyToLists()
    Sheets("ЛИСТ1").Activate
    Dim copyRn As Range, dataWs As Worksheet, copySh As Worksheet, SheetName As String
    Set copyRn = Range([A1], [A1].End(xlDown).End(xlToRight))
    Set dataWs = ActiveSheet
    dataWs.AutoFilterMode = False
    Dim uniqueDatesDic As Object
    Set uniqueDatesDic = CreateObject("Scripting.Dictionary")
    For i = 2 To copyRn.Columns(1).Cells.Count
        Set el = copyRn.Cells(i, 1)
        If Not uniqueDatesDic.Exists(el.Value) Then
            copyRn.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria1:=Array(2, el.Value)
            SheetName = Format(Day(el.Value), "00")
            uniqueDatesDic.Add Key:=el.Value, Item:=SheetName
            Set copySh = SheetRequired(SheetName, True)
            copyRn.SpecialCells(xlCellTypeVisible).Copy Destination:=copySh.Range("A1")
            copySh.Cells.EntireColumn.AutoFit
            copySh.Move after:=Sheets(Sheets.Count)
            dataWs.AutoFilter.ShowAllData
        End If
    Next i
    dataWs.Activate
    dataWs.AutoFilterMode = False
    dataWs.Move before:=Sheets(1)
End Sub

Прикрепленные файлы

primerv2.xlsm (37.29 КБ)

Изменено: tolstak — 25.09.2017 19:51:44

In GoTo we trust

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

#10

25.09.2017 19:56:36

Макрос в стандартный модуль, запускать при активном листе 1

Код

Sub Макрос1()
Dim FilteredRng As Range
Dim iDate As Date
Dim i As Long
Dim iLastRow As Long
Dim iDay As String
  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
      iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
      Columns("H").ClearContents
    Range("A1:A" & iLastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("H1"), Unique:=True
    iLastRow = Cells(Rows.Count, "H").End(xlUp).Row
      For i = 2 To iLastRow
        iDate = Cells(i, "H")
        iDay = CStr(Day(iDate))
          If Len(iDay) = 1 Then iDay = "0" & iDay
            If ActiveSheet.AutoFilterMode = False Then
                Range("A1:E1").AutoFilter
            Else
                If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
            End If
              Range("A1").AutoFilter Field:=1, Criteria1:=iDate
            With ActiveSheet.AutoFilter.Range
                Worksheets(iDay).Cells.Clear
                .Resize(.Rows.Count, 5).SpecialCells(xlCellTypeVisible).Copy Worksheets(iDay).Range("A1")
                Worksheets(iDay).Columns("A:E").AutoFit
            End With
            ActiveSheet.ShowAllData
      Next
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

desbane Пользователь Сообщений: 9 Регистрация: 25.09.2017	#11 26.09.2017 15:06:26 Всем большое спасибо. Всё работает, с моей проблемой помогло)

Источник

How to copy and paste data using a Macro in Excel. I’ll show you multiple ways to do this, including across worksheets and workbooks.

Sections:

Simple Copy/Paste

Copy Entire Range

Copy between Worksheets

Copy between Workbooks

Notes

Simple Copy/Paste

Range("A1").Copy Range("B1")

This copies cell A1 to cell B1.

Range(«A1»).Copy is the part that copies the cell.

Range(«B1») is the cell where the data will be copied.

This is a simple one line piece of code and it’s very easy to use.

Notice that there is a space between these two parts of the code.

Copy Entire Range

Range("A1:A5").Copy Range("B1:B5")

Range(«A1:A5»).Copy is the part that copies the range.

Range(«B1:B5») is the range where the data will be copied.

You can also write it like this:

Range("A1:A5").Copy Range("B1")

Notice that the range to where you will copy the data has only a reference to cell B1.

You only have to reference the very first cell to which the range will be copied and the entire range will copy in the cells below there.

NOTE: if you do it like this, you may end up overwriting data and Excel will not give you a warning about this; the data will simply be filled down as far as it needs to go to copy the first range.

Copy between Worksheets

Sheets("Sheet1").Range("A1").Copy Sheets("Sheet2").Range("B1")

This follows the same pattern as the above examples except that we need to tell the macro from which sheet we want to get the data and to which sheet we want to copy the data.

Sheets(«Sheet1»). is placed in front of the first range and that means to get the data from Sheet1, which is the name of a worksheet in the workbook.

Sheets(«Sheet2»). is placed in front of the range to which we want to copy the data and Sheet2 is the name of the worksheet where the data will be copied.

Copy between Workbooks

Workbooks("Copy and Paste Data using Macro VBA in Excel.xlsm").Sheets("Sheet1").Range("A1").Copy Workbooks("Copy and Paste Data using Macro VBA in Excel.xlsm").Sheets("Sheet3").Range("A1")

Here, we follow the above examples and, this time, add a reference to the workbooks from which we want to get the data and to which we want to place the data.

Workbooks(«Copy and Paste Data using Macro VBA in Excel.xlsm»). is the code that says in which workbook we want to place the data. Copy and Paste Data using Macro VBA in Excel.xlsm is the name of the workbook. In this example I used this for both parts, the workbook from which the data comes and where it goes. This allows you to run this macro within a single workbook and still show you how it works. In a real-world example, the first part contains the name of the workbook where you get the data from and the second contains the name of the workbook where you want to place the data.

Read this tutorial to copy values from another workbook, even if it’s closed.

Notes

All examples in the attached workbook have been commented out. Simply remove the single quote from the line of code you want to test and then run the macro.

Download the attached file to get these examples in Excel.

Subscribe for Weekly Tutorials

BONUS: subscribe now to download our Top Tutorials Ebook!

Источник

Содержание

Использование функции Dir
Условие задачи по копированию данных
Создание новых листов
Синтаксис метода Sheets.Add
Компоненты метода Sheets.Add
Примеры создания листов
Как макросом скопировать листы в Excel
Что нельзя сделать с помощью макрорекодера?
Что такое макрос?
Решение с использованием массивов
Что записывает макрос?
Используем объект FileSystemObject

Использование функции Dir

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

Вот там код данной функции, который выводит на лист 1 перечень файлов.

 '************************************************************** ' Sub : ExampleOne ' Author : Алексей Желтов ' Date : 15.06.2020 ' Purpose : Вывод всех файлов в папке на лист '************************************************************** Sub ExampleOne() Dim Sh As Worksheet Dim Folder As String Dim FileName As String Dim i As Long Set Sh = ThisWorkbook.Sheets(1) Folder = Sh.Cells(3, 2) ' Проверка корректности введенных данных If PathExists(Folder) = False Then MsgBox "Указанной папки не существует", 16, "Ошибка исходных данных" Exit Sub End If ' Удаляем содержимое Sh.Rows("7:" & Sh.Range("A7").End(xlDown).Row).Delete Shift:=xlUp i = 7 FileName = Dir(Folder & "/", vbNormal) Do While FileName <> "" Sh.Cells(i, 1) = i - 6 Sh.Cells(i, 2) = FileName i = i + 1 ' переход к следующему файлу FileName = Dir Loop End Sub

Тут мы проверяем существование папки с помощью дополнительной функции. Опять таки не используем сторонних библиотек, а используем туже функцию Dir.

 '************************************************************** ' Function : PathExists ' Author : Алексей Желтов ' Date : 15.06.2020 ' Purpose : Возвращает ИСТИНА если путь pname существует '************************************************************** Private Function PathExists(pname As String) As Boolean On Error Resume Next If Dir(pname, vbDirectory) = "" Then PathExists = False Else PathExists = (GetAttr(pname) And vbDirectory) = vbDirectory End If End Function

Вот так выглядит результат работы функции. Программа записала список файлов на текущий лист Excel.

Здесь мы не делали проверку на тип файла и вывели все файлы которые у нас были.

Если же необходимо отобрать только определенные типы файлов, например Excel файлы, то в нашем коде необходимо сделать дополнительную проверку:

 Do While FileName <> "" If LCase(FileName) Like "*xls*" Then Sh.Cells(i, 1) = i - 6 Sh.Cells(i, 2) = FileName i = i + 1 End If ' переход к следующему файлу FileName = Dir Loop

Знак “*” означает любой набор символов. Таким образом, мы учли различные версии файлов Excel (xls, xlsx, xlsm).

Условие задачи по копированию данных

На одном листе расположен список повторяющихся городов с информацией о предприятиях общепита:

Исходная таблица задания №1

Необходимо данные по каждому городу перенести в одну строку на другом листе (таблица обрезана справа):

Часть результирующего списка задания №1

Создание новых листов

Создание новых рабочих листов осуществляется с помощью метода Sheets.Add.

Синтаксис метода Sheets.Add

expression.Add [Before, After, Count, Type]

где expression – переменная, представляющая собой объект Sheet.

Компоненты метода Sheets.Add

Before* – необязательный параметр типа данных Variant, указывающий на лист, перед которым будет добавлен новый.
After* – необязательный параметр типа данных Variant, указывающий на лист, после которого будет добавлен новый.
Count – необязательный параметр типа данных Variant, указывающий, сколько листов будет добавлено (по умолчанию – 1).
Type – необязательный параметр типа данных Variant, указывающий тип листа: xlWorksheet** (рабочий лист) или xlChart (диаграмма), по умолчанию – xlWorksheet.

*Если Before и After не указаны, новый лист, по умолчанию, будет добавлен перед активным листом.

**Для создания рабочего листа (xlWorksheet) можно использовать метод Worksheets.Add, который для создания диаграмм уже не подойдет.

Примеры создания листов

‘Создание рабочего листа:

Sheets.Add

Worksheets.Add

ThisWorkbook.Sheets.Add After:=ActiveSheet, Count:=2

Workbooks(“Книга1.xlsm”).Sheets.Add After:=Лист1

Workbooks(“Книга1.xlsm”).Sheets.Add After:=Worksheets(1)

Workbooks(“Книга1.xlsm”).Sheets.Add After:=Worksheets(“Лист1”)

‘Создание нового листа с заданным именем:

Workbooks(“Книга1.xlsm”).Sheets.Add.Name = “Мой новый лист”

‘Создание диаграммы:

Sheets.Add Type:=xlChart

‘Добавление нового листа перед

‘последним листом рабочей книги

Sheets.Add Before:=Worksheets(Worksheets.Count)

‘Добавление нового листа в конец

Sheets.Add After:=Worksheets(Worksheets.Count)

Лист1 в After:=Лист1 – это уникальное имя листа, указанное в проводнике редактора VBA без скобок.
Лист1 в After:=Worksheets(«Лист1») – это имя на ярлыке листа, указанное в проводнике редактора VBA в скобках.

Создаваемый лист можно присвоить объектной переменной:

Dim myList As Object

‘В активной книге

Set myList = Worksheets.Add

‘В книге «Книга1.xlsm»

Set myList = Workbooks(“Книга1.xlsm”).Worksheets.Add

‘Работаем с переменной

myList.Name = “Listok1”

myList.Cells(1, 1) = myList.Name

‘Очищаем переменную

Set myList = Nothing

Если создаваемый лист присваивается объектной переменной, он будет помещен перед активным листом. Указать дополнительные параметры невозможно.

Допустим необходимо приготовить планы работ для сотрудников вашего отдела. Иметься шаблон таблицы для заполнения документа плана в виде одного рабочего листа Excel:

Но вам необходимо создать 12 планов и соответственно 12 листов. В программе Excel нет встроенного инструмента для многократного создания копий рабочих листов за одну операцию. А копировать и вставлять 12 (а в практике встречаются случаи что и 120) листов вручную, да еще их все нужно переименовать – это потребует много рабочего времени и пользовательских сил. Определенно лучше в таком случае воспользоваться собственным макросом. А чтобы его написать воспользуйтесь VBA-кодом, который будет представлен ниже в данной статье.

Сначала откройте редактор макросов Visual Basic:

Создайте в нем стандартный модуль с помощью опций меню: «Insert»-«Module» и введите в него этот код, который ниже представленный на листинге:

SubCopyList() DimkolvoAs Variant DimiAs Long DimlistAsWorksheet kolvo = InputBox("Укажите необходимое количество копий для данного листа") Ifkolvo =""Then Exit Sub IfIsNumeric(kolvo)Then kolvo = Fix(kolvo) Setlist = ActiveSheet Fori = 1Tokolvo list.Copy after:=ActiveSheet ActiveSheet.Name = list.Name & i Next Else MsgBox"Неправильно указано количество" End If End Sub

Теперь если нам нужно скопировать 12 (или любое другое количество) раз листов содержащие шаблон для заполнения плана работы сотрудника, кликните по исходному листу, чтобы сделать его активным и выберите инструмент: «РАЗРАБОТЧИК»-«Код»-«Макросы»-«CopyList»-«Выполнить». Сразу после запуска макроса появиться диалоговое окно, в котором следует указать количество копий листа:

Введите, например, число 12 и нажмите ОК:

Лист с шаблоном плана скопируется 12 раз, а все названия листов будут иметь такое же как название исходного листа только со своим порядковым номером от 1 до12.

Внимание! Если название исходного листа слишком длинное, тогда может возникнуть ошибка в процессе выполнения макроса. Ведь в Excel название листа не может содержать более чем 31 символ. То есть ориентируйтесь так чтобы название исходного листа было меньше чем 27 символов. Так же ошибка может возникнуть если текущая рабочая книга Excel уже содержит листы с таким названием как у копий. Ведь в Excel все листы должны иметь уникальные названия.

Примечание. В новых версиях Excel (начиная от 2010 версии) одна рабочая книга может содержать максимальное количество листов, которое ограничивается лишь размером свободной оперативной памяти системы.

Что нельзя сделать с помощью макрорекодера?

Макро-рекордер отлично подходит для вас в Excel и записывает ваши точные шаги, но может вам не подойти, когда вам нужно сделать что-то большее.

Вы не можете выполнить код без выбора объекта. Например, если вы хотите, чтобы макрос перешел на следующий рабочий лист и выделил все заполненные ячейки в столбце A, не выходя из текущей рабочей таблицы, макрорекодер не сможет этого сделать. В таких случаях вам нужно вручную редактировать код.
Вы не можете создать пользовательскую функцию с помощью макрорекордера. С помощью VBA вы можете создавать пользовательские функции, которые можно использовать на рабочем листе в качестве обычных функций.
Вы не можете создавать циклы с помощью макрорекордера. Но можете записать одно действие, а цикл добавить вручную в редакторе кода.
Вы не можете анализировать условия: вы можете проверить условия в коде с помощью макрорекордера. Если вы пишете код VBA вручную, вы можете использовать операторы IF Then Else для анализа условия и запуска кода, если true (или другой код, если false).

Что такое макрос?

Для начала немного о терминологии.

Макрос – это код, написанный на встроенном в Excel языке VBA (Visual Basic for Application). Макросы могут создаваться как вручную, так и записываться автоматически с помощью так называемого макрорекодера.

Макрорекодер – это инструмент в Excel, который пошагово записывает все что вы выполняете в Excel и преобразует это в код на языке VBA. Макрорекодер создает очень подробный код (как мы увидим позже), который вы сможете при необходимости отредактировать в дальнейшем.

Записанный макрос можно будет запускать неограниченное количество раз и Excel повторит все записанные шаги. Это означает, что даже если вы ничего не знаете о VBA, вы можете автоматизировать некоторые задачи, просто записав свои шаги и затем повторно использовать их позже.

Теперь давайте погрузимся и посмотрим, как записать макрос в Excel.

Решение с использованием массивов

Циклы в массивах работают очень быстро, но решение с ними может быть сложнее, чем при простом присваивании значений одних ячеек другим. В этом примере для упрощения кода две процедуры записаны отдельно и в нужные моменты вызываются для исполнения.

‘Объявление глобальных переменных

‘в разделе Declarations

Dim massiv1 As Variant, n2 As Long, _

n3 As Long, i1 As Long, txt1 As Variant

‘Исполняемая процедура для решения

‘задания вторым способом

Sub Resheniye2()

Dim n1 As Long, gorod As Variant

With Sheets(“Лист1”).Cells(1, 1)

massiv1 = .CurrentRegion

n1 = .CurrentRegion.Rows.Count

n2 = .CurrentRegion.Columns.Count

End With

n3 = 0

txt1 = “”

For i1 = 1 To n1

If gorod <> massiv1(i1, 1) Then

If txt1 <> “” Then

Call Vstavka

End If

gorod = massiv1(i1, 1)

txt1 = massiv1(i1, 1)

Call Kopirovanie

Else

Call Kopirovanie

End If

If i1 = n1 Then

Call Vstavka

End If

End Sub

‘Копирование данных из массива в

‘строковую переменную через разделитель

Sub Kopirovanie()

Dim i2 As Long

For i2 = 2 To n2

If massiv1(i1, i2) <> Empty Then

txt1 = txt1 & “|” & massiv1(i1, i2)

End If

End Sub

‘Обработка данных из строковой

‘переменной в дополнительных массивах и

‘вставка очередной строки на второй лист

Sub Vstavka()

Dim n4 As Long, massiv2 As Variant, _

massiv3 As Variant, i3 As Long

n3 = n3 + 1

massiv2 = Split(txt1, “|”)

n4 = UBound(massiv2)

ReDim massiv3(0 To 0, 0 To n4)

For i3 = 0 To n4

massiv3(0, i3) = massiv2(i3)

Sheets(“Лист2”).Range(Cells(n3, 1), _

Cells(n3, n4 + 1)).Value = massiv3

End Sub

Подпрограммы Kopirovanie и Vstavka используются в цикле For... Next процедуры Resheniye2 по два раза, поэтому их коды вынесены за пределы процедуры Resheniye2 и вызываются по мере необходимости.

Переменные:

massiv1 – его элементам присваиваются значения ячеек исходной таблицы;
massiv2 – одномерный массив, заполняемый данными из переменной txt1;
massiv3 – двумерный массив, заполняемый данными из одномерного массива massiv2 и используемый для вставки очередной строки на второй лист;
txt1 – сюда копируются через разделитель значения элементов массива massiv1, предназначенные для заполнения очередной строки на втором листе;
n1 – количество строк в исходной таблице;
n2 – количество столбцов в исходной таблице;
n3 – номер текущей строки на втором листе;
n4 – количество столбцов текущей строки на втором листе (соответствует количеству элементов массива massiv2);
i1, i2, i3 – счетчики цикла For… Next

gorod – переменная с наименованием города, предназначенная для контроля за сменой текущего города, который обрабатывается циклом.

Что записывает макрос?

Теперь перейдем к редактору кода и посмотрим что у нас получилось.

Вот шаги по открытию редактора VB в Excel:

Перейдите на вкладку “Разработчик”.

В группе “Код” нажмите кнопку “Visual Basic”.

Вы также можете использовать комбинацию клавиш Alt + F11 и перейти в редактор кода VBA.

Рассмотрим сам редактор кода. Далее коротко опишем интерфейс редактора.

Панель меню: содержит команды, которые можно использовать во время работы с редактором VB.

Панель инструментов – похожа на панель быстрого доступа в Excel. Вы можете добавить к ней дополнительные инструменты, которыми часто пользуетесь.

Окно проектов (Project Explorer) – здесь Excel перечисляет все книги и все объекты в каждой книге. Например, если у нас есть книга с 3 рабочими листами, она появится в Project Explorer. Здесь есть несколько дополнительных объектов, таких как модули, пользовательские формы и модули классов.

Окно кода – собственно сам код VBA размещается в этом окне. Для каждого объекта, указанного в проводнике проекта, есть окно кода, например, рабочие листы, книги, модули и т. д. В этом уроке мы увидим, что записанный макрос находится в окне кода модуля.

Окно свойств – вы можете увидеть свойства каждого объекта в этом окне. Я часто использую это окно для обозначения объектов или изменения их свойств.

Immediate Window (окно предпросмотра) – На начальном этапе оно вам не пригодится. Оно полезно, когда вы хотите протестировать шаги или во время отладки. Он по умолчанию не отображается, и вы можете его отобразить, щелкнув вкладку «View» и выбрав опцию «Immediate Window».

Когда мы записали макрос “ВводТекста”, в редакторе VB произошли следующие вещи:

Был добавлен новый модуль.

Макрос был записан с именем, которое мы указали – “ВводТекста”

В окне кода добавлена новая процедура.

Поэтому, если вы дважды щелкните по модулю (в нашем случае модуль 1), появится окно кода, как показано ниже.

Вот код, который записан макрорекодером:

Sub ВводТекста() ' ' ВводТекста Макрос ' ' Range("A2").Select ActiveCell.FormulaR1C1 = "Excel" Range("A3").Select End Sub

В VBA, любая строка , которая следует за ‘ (знак апострофа) не выполняется. Это комментарий, который предназначен только для информационных целей. Если вы удалите первые пять строк этого кода, макрос по-прежнему будет работать.

Теперь давайте пробежим по каждой строке кода и опишем что и зачем.

Код начинается с Sub, за которым следует имя макроса и пустые круглые скобки. Sub – сокращение для подпрограммы. Каждая подпрограмма (также называемая процедурой) в VBA начинается с Sub и заканчивается End Sub.

Range(“A2”).Select – эта строка выбирает ячейку A2.

ActiveCell.FormulaR1C1 = «Excel» – эта строка вводит текст “Excel” в активной ячейке. Поскольку мы выбрали ячейку A2 в качестве первого шага, она становится нашей активной ячейкой.

Range(“A3”).Select – выбор ячейки A3. Это происходит, когда мы нажимаем клавишу Enter после ввода текста, результатом которого является выбор ячейки A3.

Надеюсь, что у вас есть некоторое базовое понимание того, как записывать макрос в Excel.

Обращаем внимание, что код, записанный через макрорекордер, как правило, не является эффективным и оптимизированным кодом. Макрорекордер часто добавляет дополнительные ненужные действия. Но это не значит, что не нужно пользоваться макрорекодером. Для тех, кто только изучает VBA , макрорекордер может быть отличным способом проанализировать и понять как все работает в VBA.

Используем объект FileSystemObject

В данном случае мы будем не просто получать названия файлов, но также определять тип файла, получать его размер и дату создания. Для этого нам потребуется использовать объект FileSystemObject. Он предоставляет нам сведения о файловой системе компьютера.

Однако, чтобы начать его использовать придется подключить одну библиотеку. Не пугайтесь, она есть на всех компьютерах с Windows, потому скачивать ничего не придется. Чтобы подключить ее необходимо:

Открыть пункт меню Tools и выбрать пункт References.

Выбрать ссылку на библиотеку Microsoft Scripting Runtime.

Нажать Ок.

Теперь перейдем к коду. Он немного упростился:

'************************************************************** ' Sub : ExampleTwo ' Author : Алексей Желтов ' Date : 15.06.2020 ' Purpose : Вывод всех файлов в папке на лист '************************************************************** Sub ExampleTwo() Dim Sh As Worksheet Dim FSO As New FileSystemObject Dim FolderPath As String Dim MyFolder As Folder Dim iFile As File Dim i As Long Set Sh = ThisWorkbook.Sheets(2) FolderPath = Sh.Cells(3, 2) ' Проверка корректности введенных данных If Not FSO.FolderExists(FolderPath) Then MsgBox "Указанной папки не существует", 16, "Ошибка исходных данных" Exit Sub End If ' Удаляем содержимое Sh.Rows("7:" & Sh.Range("A7").End(xlDown).Row).Delete Shift:=xlUp Set MyFolder = FSO.GetFolder(FolderPath) i = 7 For Each iFile In MyFolder.Files Sh.Cells(i, 1) = i - 6 Sh.Cells(i, 2) = iFile.Name Sh.Cells(i, 3) = iFile.Type Sh.Cells(i, 4) = iFile.DateCreated Sh.Cells(i, 5) = iFile.Size i = i + 1 Next End Sub

Обратите внимание на переменные. Переменная FSO – это новый экземпляр объекта FileSystemObject. Тут мы его объявляем и сразу создаем. Директива New очень важна, многие тут допускают ошибку. Также создаем объекты MyFolder и iFile – это тоже объекты FileSystemObject

Dim Sh As Worksheet Dim FSO As New FileSystemObject ' объявляем и создаем новый экземпляр объекта Dim FolderPath As String Dim MyFolder As Folder Dim iFile As File Dim i As Long

Далее делаем проверку на существование папки. В данном случае нам не нужна дополнительная функция , мы пользуемся методом FolderExists объекта (класса) FileSystemObject.

Ну и остается аналогично перебрать все файлы в директории. Тут удобно использовать цикл For Each – Next.

For Each iFile In MyFolder.Files Sh.Cells(i, 1) = i - 6 Sh.Cells(i, 2) = iFile.Name ' название файла Sh.Cells(i, 3) = iFile.Type ' тип файла Sh.Cells(i, 4) = iFile.DateCreated ' дата создания Sh.Cells(i, 5) = iFile.Size ' размер i = i + 1 Next

Результат работы программы следующий:

Источники

https://micro-solution.ru/excel/vba/get-files-in-folder

https://vremya-ne-zhdet.ru/vba-excel/resheniye-zadaniya-1/

https://vremya-ne-zhdet.ru/vba-excel/rabochiy-list-sozdaniye-kopirovaniye-udaleniye/

https://exceltable.com/vba-macros/makros-kopirovanie-lista

https://micro-solution.ru/excel/vba/first-macros

Источник

Возможности макросов в Excel практически неограниченные. В данном примере покажем в пару кликов можно создать любое количество копий листов используя VBA-макрос.

Как макросом скопировать листы в Excel

Сначала откройте редактор макросов Visual Basic:

Sub CopyList() Dim kolvo As Variant Dim i As Long Dim list As Worksheet kolvo = InputBox("Укажите необходимое количество копий для данного листа") If kolvo = "" Then Exit Sub If IsNumeric(kolvo) Then kolvo = Fix(kolvo) Set list = ActiveSheet For i = 1 To kolvo list.Copy after:=ActiveSheet ActiveSheet.Name = list.Name & i Next Else MsgBox "Неправильно указано количество" End If End Sub

Введите, например, число 12 и нажмите ОК:

Описание кода макроса для копирования листов Excel

В коде используются 3 переменные:

kolvo – в этой переменной определено какое количество копий будет создано при копировании текущего рабочего листа Excel.
i – счетчик циклов.
list – в этой переменной будет создан экземпляр объекта листа Excel.

В начале макроса вызываем диалоговое окно, в котором пользователь должен указать в поле ввода какое количество копий листов необходимо создать с помощью данного макроса «CopyList». Введенное числовое значение в поле ввода из этого диалогового окна передается в переменную kolvo. Если поле ввода пустое или в диалоговом окне была нажата кнопка отмены «Cancel», тогда дальнейшие инструкции не выполняться и работа макроса прерывается.

В следующей строке кода проверяется: является ли введенное значение в поле ввода – числовым? Если да, тогда на всякий случай удаляются все числа после запятой с помощью функции Fix.

Далее в переменой list создается экземпляр объекта ActiveSheet. После в цикле копируются листы. Количество циклов выполняется ровно столько, сколько пользователь указал в диалоговом окне макроса. В процессе копирования каждый раз изменяется название для новой копии листа. Так как в одной книге не может быть 2 и более листов с одинаковым названием. Уникальные названия для каждой копии создаются за счет присвоения к названию исходного листа число с порядковым номером текущего цикла. При необходимости пользователь может задать свои параметры для присвоения названия копиям листов изменив данную строку кода. Главное придерживаться правила уникальности названий листов.

Примечание. Если нет необходимости настраивать названия для новых листов, тогда данную строку кода можно закомментировать.

‘ActiveSheet.Name = list.Name & i

Читайте также: Макрос для переименования листов Excel при копировании.

В таком случае названия для копий Excel будет присваивать сам. Например, для исходного листа с названием «Лист1» копии будут получать названия: «Лист1 (2)», «Лист1 (3)», «Лист1 (4)» и т.д.

В конце кода выводиться сообщение на тот случай если пользователь неправильно указал числовое значение в поле ввода диалогового окна макроса.

Источник

Копирование строк таблицы в разные листы по условию

Aleksej

Дата: Среда, 16.03.2016, 11:04 |
Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 69

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

Доброго времени суток, уважаемые форумчане!

Нужна помощь в написании макроса.

Суть идеи такова:
1. Имеется таблица 23 столбца (лист «ДАНО»)
2. Ориентир столбец №3 (в нем содержатся или ДО или РНС или ДМТР)
3. Если в столбце №3 ДО то строчку таблицы копируем на лист «ДО», если РНС то копируем на лист «РНС», соответственно ДМТР копируем строку на лист «ДМТР»
4. на лист «сводная» копируем строчки с ДО но только выборочные столбцы (номера столбцов я указал в примере).

Если возможно, то с комментариями в коде, т.к. сам пытаюсь изучать VBA, чтоб потом можно было разобраться

Сообщение отредактировал Aleksej — Среда, 16.03.2016, 11:04

Ответить

KuklP

Дата: Среда, 16.03.2016, 11:39 |
Сообщение № 2

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация:
486
±

Замечаний:
0% ±

2003-2010

[vba]

Код

Public Sub www()
    Dim a, i&, sh As Worksheet
    a = Array(«ДО», «РНС», «ДМТР»)
    For i = 0 To 2
        Me.[b19].CurrentRegion.AutoFilter 3, a(i)
        Me.[b19].CurrentRegion.SpecialCells(12).Copy Sheets(a(i)).[b7]
        If a(i) = «ДО» Then
            Intersect(Me.[b19].CurrentRegion.SpecialCells(12), Me.Range((«b:d,H:h,m:m,y:y»))).Copy Sheets(«Сводная»).[b7]
            Intersect(Me.[b19].CurrentRegion.SpecialCells(12), Me.Range(«H:h,r:r»)).Copy Sheets(«Сводная»).[h7]
        End If
    Next
    Me.AutoFilterMode = 0
End Sub

[/vba]

К сообщению приложен файл:

4576.xlsm
(34.3 Kb)

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

Aleksej

Дата: Среда, 16.03.2016, 11:55 |
Сообщение № 3

Группа: Пользователи

Ранг: Участник

Сообщений: 69

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

KuklP, спасибо большое , вроде все работает. :hands:

Только я то хотел посмотреть код, разобраться, а у тебя часть функций спрятана под пароль.
Работает конечно, но каким образом непонятно. <_<

Сообщение отредактировал Aleksej — Среда, 16.03.2016, 14:15

Ответить

Hugo

Дата: Среда, 16.03.2016, 18:14 |
Сообщение № 4

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3140

Репутация:
670
±

Замечаний:
0% ±

2010, теперь уже с PQ

Aleksej, не вижу там никаких паролей (только ради этого файл скачал ), да и даже если бы были — код ведь вот он, в посте.
P.S. Сергей, привет!

excel@nxt.ru
webmoney: R418926282008 Z422237915069

Ответить

KuklP

Дата: Среда, 16.03.2016, 19:18 |
Сообщение № 5

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация:
486
±

Замечаний:
0% ±

2003-2010

Привет, дружище. Ну да, кто-кто, а я как раз бы пароли ставил.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

Aleksej

Дата: Среда, 23.03.2016, 07:45 |
Сообщение № 6

Группа: Пользователи

Ранг: Участник

Сообщений: 69

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

KuklP, Добрый день! Да точно нет пароля, извиняюсь
Просто был открыт другой документ экселя, а в редакторе VBA они же вместе показываются.

С кодом мало мальски разобрался, но не полностью.
1. не могу понять что такое «sh»
2. Почему когда удаляешь номера столбцов в листе ДАНО, макрос перестает сортировать, не могу понять как он связан с нумерацией столбцов? %)
3. Почему макрос копирует нумерацию, если в коде указано начинать сортировку со строчки ниже, тоже непонятно?

Спасибо ещё раз за помощь!

Ответить

KuklP

Дата: Среда, 23.03.2016, 10:20 |
Сообщение № 7

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация:
486
±

Замечаний:
0% ±

2003-2010

1. не могу понять что такое «sh»

ничего, это лишнее, писалось «на вырост» и не пригодилось. Можно убрать.
2),3) — непонятно о чем. Ни в макросе ни в топике ни о какой сортировке речь не идет.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

Aleksej

Дата: Среда, 23.03.2016, 11:35 |
Сообщение № 8

Группа: Пользователи

Ранг: Участник

Сообщений: 69

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

KuklP, спс что ответил
под сортировкой я имел ввиду:
— если ДО то на один лист копирует
— РНС на другой лист и т.д. (типа сортирует )

Я не могу понять, почему если с листа ДАНО, очистить или удалить строку с нумерацией столбцов (1, 2, 3, 4.1, 4.2, 5, 6 и т.д.), макрос перестает работать,
а если не удалять то он эту строку за собой на все листы тащит?

Ответить

KuklP

Дата: Среда, 23.03.2016, 11:49 |
Сообщение № 9

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация:
486
±

Замечаний:
0% ±

2003-2010

если с листа ДАНО, очистить или удалить строку с нумерацией столбцов (1, 2, 3, 4.1, 4.2, 5, 6 и т.д.), макрос перестает работать

так если удалить всю книгу, то и макроса не будет. Странный вопрос. Вам наверное надо начать с чего-то попроще. Что такое таблица, что такое заголовки.

а если не удалять то он эту строку за собой на все листы тащит?

а где в топике написано, что этого делать не надо?

P.S. да кстати:

мы с Вами старые приятели? Что-то не припомню.. Я вот к Вам на Вы.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

Aleksej

Дата: Среда, 23.03.2016, 12:28 |
Сообщение № 10

Группа: Пользователи

Ранг: Участник

Сообщений: 69

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

KuklP,

Цитата

мы с Вами старые приятели? Что-то не припомню.. Я вот к Вам на Вы.

Сами же написали Извиняюсь если что не так.

Цитата

а где в топике написано, что этого делать не надо?

Я же не говорил что сделали не так, просто разобраться хочу :). Решил проблему частично, после копирования добавил в код чтоб удалять эту строку.

Цитата

Вам наверное надо начать с чего-то попроще.

Хотелось бы. Но необходимость решения конкретной задачи, как это чаще всего и бывает , толкает вперед. :).
Но из вашего кода я много почерпнул, посидел пару часов разобрался, что то под себя переработал. Просто остались пробелы и непонятки вот и хотел уточнить. yes

Сообщение отредактировал Aleksej — Среда, 23.03.2016, 12:40

Ответить

KuklP

Дата: Среда, 23.03.2016, 13:04 |
Сообщение № 11

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация:
486
±

Замечаний:
0% ±

2003-2010

Это я обращался к Игорю Hugo. Ладно, проехали. По поводу заголовков почитайте справку по resize и offset, там и примеры были. Вам в принципе достаточно offset, но для resize пример поподробней.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

Wasilich

Дата: Среда, 23.03.2016, 13:38 |
Сообщение № 12

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

Репутация:
326
±

Замечаний:
0% ±

2003

Может этот макрос упростит понимание, применение и снизит скорость.
[vba]

Код

Sub www()
  Dim R1&, R2&, R3&, i&
  R1 = 7: R2 = 7: R3 = 7
  For i = 20 To Range(«D» & Rows.Count).End(xlUp).Row
    Select Case Cells(i, 4)
      Case «ДО»
        Range(Cells(i, 2), Cells(i, 25)).Copy Sheets(«ДО»).Cells(R1, 2)
        Union(Cells(i, «B»), Cells(i, «C»), Cells(i, «D»)).Copy Sheets(«Сводная»).Cells(R1, 2)
        Union(Cells(i, «H»), Cells(i, «M»), Cells(i, «Y»)).Copy Sheets(«Сводная»).Cells(R1, 5)
        Union(Cells(i, «H»), Cells(i, «R»)).Copy Sheets(«Сводная»).Cells(R1,
        R1 = R1 + 1
      Case «РНС»
        Range(Cells(i, 2), Cells(i, 25)).Copy Sheets(«РНС»).Cells(R2, 2)
        R2 = R2 + 1
      Case «ДМТР»
        Range(Cells(i, 2), Cells(i, 25)).Copy Sheets(«ДМТР»).Cells(R3, 2)
        R3 = R3 + 1
    End Select
  Next
End Sub

[/vba]

Ответить

Aleksej

Дата: Среда, 23.03.2016, 14:07 |
Сообщение № 13

Группа: Пользователи

Ранг: Участник

Сообщений: 69

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

KuklP, Спасибо!

Ответить

Aleksej

Дата: Среда, 23.03.2016, 14:14 |
Сообщение № 14

Группа: Пользователи

Ранг: Участник

Сообщений: 69

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

Wasilich, Спасибо! Я когда собирался написать макрос, примерно так его и представлял, сейчас буду разбираться.

Поэтому я и впал в ступор когда увидел код KuklP решение по своему интересное и для меня неожиданное.

Сообщение отредактировал Aleksej — Среда, 23.03.2016, 14:42

Ответить

Источник