Excel - копировать строки на общую страницу

вопрос

У меня есть таблица Excel с 13 листами. Первые 12 листов с января по декабрь. 13-й лист является итогом. Каждый лист имеет одинаковые столбцы и строки.

Во всех таблицах имеется около 10 столбцов, таких как Дата, Имя, Адрес, Номер счета, Отдел, Имя сотрудника и т. Д.

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

Я настроил все рабочие листы, но не могу придумать код, чтобы сделать копию. Любые предложения, пожалуйста?

Решение

Попробуй это. Конечно, убедитесь, что вы сделали резервную копию исходного файла перед тестированием

Предположения.

  • 1. Листы носят имена январь, февраль, ....
  • 2. Мастер лист называется Мастер
  • 3. Столбец 1 не имеет пустого значения (он используется для поиска максимального количества строк)
  • 4. Не более 11 столбцов
  • 5. Мастер лист уже имеет строку заголовка.

 Sub copyData () Dim maxRows As Long Dim maxCols As Integer Dim conSheet As String 'имя объединенного листа Dim lConRow As Long Dim maxRowCol As Integer', используемый для поиска максимального числа строк maxCols = 11 months = Array ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") maxRowCol = 1 conSheet = "Основные" листы (conSheet). Выбрать диапазон ("A2"). Выбрать ячейки (65536, 256). Выбрать Selection.End (xlDown). Выбрать maxRows = Selection.Row Range ("A2", Selection). Выбрать Selection.ClearContents lConRow = 2 Для x = 0 до Sheets.Count - 2 листа (месяцы (x)). Выберите If ActiveSheet.AutoFilterMode Then Cells.Select Selection.AutoFilter End If Cells.Select Dim lastRow As Long lastRow = Cells (maxRows, maxRowCol) .End ( xlUp) .Row If (lastRow> 1) Then Range (Cells (2, 1), Cells (lastRow, maxCols)). Выбрать Selection.Copy Sheets (conSheet). Выбрать ячейки (lConRow, 1). Выбрать Selection.PasteSpecial lConRow = Ячейки (maxRows, maxRowCol) .End (xlUp) .Row lConRow = lSummaryRow + 1 End If If ActiveSheet.Name = "Dec «Затем выйдите из Sub Next End Sub 

Заметка

Спасибо rizvisa1 за этот совет на форуме.

Предыдущая статья Следующая статья

Лучшие советы