Question

这是我第一次来，很抱歉。

我有一个包含几张纸的文件，我需要从A14复制到I14，然后执行

Range(Selection, Selection.End(xlDown)).Select

为了捕获从原始范围到底部的所有数据，所有工作表的行数都不同，这就是为什么我需要这样做。

一旦选择了数据，我需要复制并粘贴到另一个名为“报告”的选项卡中，并且需要对工作簿中的每个工作表进行此操作。

每次将工作表粘贴到“报告”选项卡中时，下一张工作表都需要进入“报告”选项卡的下一个导航行中，换句话说，我不能粘贴到最后一个信息上方。是滚动报告。

Answer 1

不了解此问题，但有一些提示：

使用以下命令查找使用的最后一行：

Dim LastRow As Long
Dim ws as Worksheet
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

注意：将搜索第1列（A）。

使用以下方法遍历所有工作表：

Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
         'Your code goes here
    next ws

Answer 2

Take this as base and adjust to your requirement. This program is Untested and may require adjustment for Header Rows. I have commented out Header Rows in program keeping in view you want to start from `Row1`

Sub CopyToReport()
    Dim wrk As Workbook         'Workbook object - Always good to work with object variables
    Dim sht As Worksheet        'Object for handling worksheets in loop
    Dim trg As Worksheet        'Master Worksheet
    Dim rng As Range            'Range object
    Dim colCount As Integer     'Column count in tables in the worksheets

    'Speed things up
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False

    'Working in active workbook
        Set wrk = ActiveWorkbook

    'Create/Reset the Report sheet
        If Evaluate("ISREF(Report!A1)") Then
            wrk.Sheets("Report").Move After:=Worksheets(Worksheets.Count)
            wrk.Sheets("Report").Cells.Clear
        Else
            wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)).Name = "Report"
        End If

        Set trg = wrk.Sheets("Report")

        'Get column headers from the first worksheet
            'Column count first
            Set sht = wrk.Worksheets(1)
           ' colCount = sht.Cells(1, Columns.Count).End(xlToLeft).Column
             colCount =9
            'Now retrieve headers, no copy&paste needed
            'With trg.Cells(1, 1).Resize(1, colCount)
             '   .Value = sht.Cells(1, 1).Resize(1, colCount).Value
              '  'Set font as bold
               ' .Font.Bold = True
            'End With

        'We can start loop
        For Each sht In wrk.Worksheets
            'Execute on every sheet except the Master
            If sht.Name <> "Master" Then
                'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
                'Set rng = sht.Range(sht.Cells(1, 1), sht.Cells(Rows.Count, colCount).End(xlUp))
                Set rng = sht.Range("A1:I14")
                'Put data into the Master worksheet
                trg.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
            End If
        Next sht

        'Fit the columns in Master worksheet
            trg.Columns.AutoFit

        'Screen updating should be activated
            Application.ScreenUpdating = True
    End Sub

将特定范围从多个工作表复制到单个工作表作为滚动报告

2 个答案: