VBA для копирования определенных столбцов на все листы

Question

Привет! Я ищу, чтобы создать код для копирования определенных столбцов (AH в AX) по всем рабочим листам, а затем пропускает рабочие листы с именами «Совокупные» и «Сопоставленные результаты»

У меня уже есть

Sub FillSheets()
 Dim ws As Worksheets
 Dim worksheetsToSkip As Variant
 Dim rng As Range
 Dim sh As Sheet1


 Set rng = sh.Range("AH1:AX7200")


 worksheetsToSkip = Array("Aggregated", "Collated Results")
  For Each ws In Worksheets
  If IsError(Application.Match(ws.Name, worksheetsToSkip, 0)) Then




End Sub

Answer 1

Это будет

1. Проход по листам
2. «Копировать» данные из AH1 - AX1 до последней использованной строки, которая определяется по Column AH (при необходимости обновите столбец)
3. «Вставить» данные на лист с именем Sheet1 (при необходимости обновить).Данные будут вставлены в Column AH в первой доступной пустой строке.Непонятно, в какой столбец вы хотите вставить данные. Вам просто нужно изменить AH на Some Column, чтобы изменить

"Копировать" и "Вставить" в кавычках, потому что мы действительнопросто перенести значения здесь, так как это быстрее.Мы на самом деле устанавливаем значения двух равных по размеру диапазонов равными друг другу.

---

Option Explicit

Sub AH_AX()

'Update "Sheet1" to sheet where data is being pasted
Dim ms As Worksheet: Set ms = ThisWorkbook.Sheets("Sheet1")

Dim ws As Worksheet, wsLR As Long, msLR As Long
Dim CopyRange As Range, PasteRange As Range

For Each ws In Worksheets
    If ws.Name <> "Aggregated" And ws.Name <> "Collated Results" Then

        'Determine last rows
        wsLR = ws.Range("AH" & ws.Rows.Count).End(xlUp).Row
        msLR = ms.Range("AH" & ms.Rows.Count).End(xlUp).Offset(1).Row

        'Set Ranges
        Set CopyRange = ws.Range("AH1:AX" & LR)
        Set PasteRange = ms.Range("AH" & msLR).Resize(CopyRange.Rows.Count, CopyRange.Columns.Count)

        'Value Transfer (Quicker than copy/paste)
        PasteRange.Value = CopyRange.Value

    End If
Next ws

End Sub