Блог

Главная - Вопросы по программированию - Как скопировать ту же часть данных с 232 листов в таблицу?

Как скопировать ту же часть данных с 232 листов в таблицу?

#excel #vba

#excel #vba

Вопрос:

Я пытаюсь скопировать набор данных из 232 последовательных электронных таблиц, а затем выгрузить в основную электронную таблицу.

Кажется, я делаю что-то не так с активацией листов.

 Sub mcrExtractData()
    
    Dim i As Integer
    Dim introw As Integer
    
    For i = 1 To 10

        For introw = 1 To 10
    
            Sheets("Sheet amp; i").Select   Range("B3:B5").Select
            Selection.Copy
            Sheets("Sheet500").Select
            Range("A amp; introw").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=True
    
            Sheets("Sheet amp; i").Select
            Range("Q7:Q12").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet500").Select
            Range("A amp; introw").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=True
    
        Next introw
    
    Next i

End Sub

Комментарии:

1. Вы копируете 9 значений. Вы хотите вставить их из столбцов A в столбец I в первой доступной строке Sheet500 ? Лучше указать точный диапазон для каждого копируемого листа.

2. Знаем ли мы, сколько строк или столбцов в каждой электронной таблице? Каждая электронная таблица начинается с ячейки «A1» или это отличается? Каждая ячейка на каждой вкладке имеет значение или некоторые из них могут быть пустыми?

3. Sheets("Sheet amp; i") и Range("A amp; introw") не имеет смысла. VBA ищет лист / ячейку с точно таким именем. Я думаю, вам следует использовать Sheets("Sheet " amp; i) и Range("A" amp; introw) заметить, что я изменил положение "

Ответ №1:

Диапазон копирования с нескольких листов

Код

 Option Explicit

Sub mcrExtractData()
    
    Const tgtName As String = "Sheet500"
    Const tgtFirst As String = "A2"
    Const genName As String = "Sheet"
    Const NumberOfWorksheets As Long = 232

    ' Define workbook.
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    ' Define Source Array ('Source').
    Dim Source As Variant
    ReDim Source(1 To NumberOfWorksheets, 1 To 2)
    
    ' Declare additional variables before loop.
    Dim ws As Worksheet ' Current Source Worksheet,
                        ' Target Worksheet.
    Dim i As Long       ' Current Worksheet Index,
                        ' Current Source Array Row,
                        ' Current Target Array Row.
    
    ' Write values from Source Worksheets to arrays of Source Array.
    For i = 1 To NumberOfWorksheets
        Set ws = wb.Worksheets(genName amp; i)
        Source(i, 1) = ws.Range("B3:B5").Value
        Source(i, 2) = ws.Range("Q7:Q12").Value
    Next i
    
    ' Define Target Array ('Target').
    Dim Target As Variant
    ReDim Target(1 To NumberOfWorksheets, 1 To 9)
    
    ' Declare additional variables before loop.
    Dim j As Long ' Current Target Array Column.
    
    ' Write values from arrays of Source Array to Target Array.
    For i = 1 To NumberOfWorksheets
        For j = 1 To 3
            Target(i, j) = Source(i, 1)(j, 1)
        Next j
        For j = 4 To 9
            Target(i, j) = Source(i, 2)(j - 3, 1)
        Next j
    Next i
    
    ' Define Target Worksheet ('ws').
    Set ws = wb.Worksheets(tgtName)
    ' Write values from Target Array to Target Range.
    ws.Range(tgtFirst).Resize(NumberOfWorksheets, 9).Value = Target
    
End Sub