Код VBA для l oop через разные листы и принимает определенные c столбцы

Question

• 1000

Я уверен, что этот вопрос задавался раньше - моя попытка кода приведена ниже.

Я попытался сделать это для одного столбца, но я застрял в бесконечном l oop.

любая помощь приветствуется.

Sub SummarySheet()

Dim WKSheetSummarySheet As Worksheet, WKSheetDataSheet1 As Worksheet, WKSheetDataSheet2 As Worksheet, WKSheetDataSheet3 As Worksheet, WKSheetDataSheet4 As Worksheet
Dim LastRowSummarySheet As Long, LastRowDataSheet1 As Long, LastRowDataSheet2 As Long, LastRowDataSheet3 As Long, LastRowDataSheet4 As Long
Dim LastColSummarySheet As Long, LastColDataSheet1 As Long, LastColDataSheet2 As Long, LastColDataSheet3 As Long, LastColDataSheet4 As Long
Dim RangeSummarySheet As Range, RangeDataSheet1 As Range, RangeDataSheet2 As Range, RangeDataSheet3 As Range, RangeDataSheet4 As Range

Set WKSheetSummarySheet = ThisWorkbook.Worksheets("SummarySheet")
Set WKSheetDataSheet1 = ThisWorkbook.Worksheets("DataSheet1")
Set WKSheetDataSheet2 = ThisWorkbook.Worksheets("DataSheet2")
Set WKSheetDataSheet3 = ThisWorkbook.Worksheets("DataSheet3")
Set WKSheetDataSheet4 = ThisWorkbook.Worksheets("DataSheet4")

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlManual
End With

On Error Resume Next

LastRowSummarySheet = WKSheetSummarySheet.Cells(WKSheetSummarySheet.Rows.Count, 1).End(xlUp).Row
LastRowDataSheet1 = WKSheetDataSheet1.Cells(WKSheetDataSheet1.Rows.Count, 1).End(xlUp).Row
LastRowDataSheet2 = WKSheetDataSheet2.Cells(WKSheetDataSheet2.Rows.Count, 1).End(xlUp).Row
LastRowDataSheet3 = WKSheetDataSheet3.Cells(WKSheetDataSheet3.Rows.Count, 1).End(xlUp).Row
LastRowDataSheet4 = WKSheetDataSheet4.Cells(WKSheetDataSheet4.Rows.Count, 1).End(xlUp).Row
LastColSummarySheet = WKSheetSummarySheet.Cells(1, WKSheetSummarySheet.Columns.Count).End(xlToLeft).Column
LastColDataSheet1 = WKSheetDataSheet1.Cells(1, WKSheetDataSheet1.Columns.Count).End(xlToLeft).Column
LastColDataSheet2 = WKSheetDataSheet2.Cells(1, WKSheetDataSheet2.Columns.Count).End(xlToLeft).Column
LastColDataSheet3 = WKSheetDataSheet3.Cells(1, WKSheetDataSheet3.Columns.Count).End(xlToLeft).Column
LastColDataSheet4 = WKSheetDataSheet4.Cells(1, WKSheetDataSheet4.Columns.Count).End(xlToLeft).Column

Set RangeSummarySheet = Range(RangeSummarySheet.Cells(3, 2), RangeSummarySheet.Cells(LastRowSummarySheet, LastColSummarySheet))
Set RangeDataSheet1 = Range(RangeDataSheet1.Cells(5, 1), RangeDataSheet1.Cells(LastRowDataSheet1, LastColDataSheet1))
Set RangeDataSheet2 = Range(RangeDataSheet2.Cells(5, 1), RangeDataSheet2.Cells(LastRowDataSheet2, LastColDataSheet2))
Set RangeDataSheet3 = Range(RangeDataSheet3.Cells(5, 1), RangeDataSheet3.Cells(LastRowDataSheet3, LastColDataSheet3))
Set RangeDataSheet4 = Range(RangeDataSheet4.Cells(5, 1), RangeDataSheet4.Cells(LastRowDataSheet4, LastColDataSheet4))

Do Until IsEmpty(RangeDataSheet1(1))
    
    RangeDataSheet1(1) = RangeSummarySheet(1)
           
    Set RangeDataSheet1 = RangeDataSheet1.Offset(1, 0)
    Set RangeSummarySheet = RangeSummarySheet.Offset(1, 0)
    
Loop

End Sub

Answer 1

Я пытался расшифровать то, чего вы хотели добиться; Если этот код неверен, поясните, что вы пытаетесь выполнить sh, и предоставьте пример данных. Этот базовый c код ниже будет l oop через ваши четыре таблицы данных скопировать диапазон от «A5» до последней строки и последнего столбца, а затем вставить сводную таблицу в следующую пустую строку для каждого l oop. Комментарии добавляются в код.

Примечание : при использовании метода «Равно» исходный и целевой диапазоны должны совпадать.

Sub ConsolidateSheetDataInSumSheet()
'This code will copy the range starting at "A5" to the lastrow and lastcolumn from each `DataSheet`,
'and paste to the next empty cell in `Column 2` in the 'SummarySheet'

Dim wsSum As Worksheet: Set wsSum = ThisWorkbook.Sheets("SummarySheet") 'Define the SummmarySheet variable

    For x = 1 To 4 'Loop from 1 to 4 (the number for each datasheet)
        With ThisWorkbook.Sheets("DataSheet" & x) 'DataSheet1, DataSheet2, etc.

            'The next line sets the range from for each `DataSheet`, copies the range and 
            'pastes the copied range to the next empty cell in the `SummarySheet`
            'the line is separated using the Dash, `_`, for ease of reading

            .Range(.Cells(5, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column)).Copy _
            wsSum.Cells(Rows.Count, 2).End(xlUp).Offset(1)
        End With
    Next x 'Go to next `DataSheet`
End Sub