Question

我有大约150张工作表，我目前正在尝试合并到一张工作表中。我有以下代码，我正在使用

Sub Consolidate()
Dim sh1 As Worksheet, current As Worksheet, lr As Long, rng As Range, sh As Worksheet
Set sh1 = Sheets("Sheet1")
For Each current In Worksheets
   Set sh = Sheets(current.Name)
   lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
   Set rng = sh.Range("A9:A" & lr)
   rng.EntireRow.Copy sh1.Cells(Rows.Count, 1).End(xlUp)(2)
Next
End Sub

我想要做的是在每行的末尾添加一个条目，以便跟踪它来自哪个文件。每个工作表上都提供了这些特定信息。

例如

AAA 1 Worksheet1
BBB 2 Worksheet2

非常感谢任何帮助。

Answer 1

包括@ Christmas007的评论：

Sub Consolidate()

    Dim sh1 As Worksheet,  lr As Long, rng As Range, sh As Worksheet
    Set sh1 = Sheets("Sheet1")

    For Each sh In Worksheets
       If sh.Name <> sh1.Name Then
       lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
       Set rng = sh.Range("A9:A" & lr)
       with sh1.Cells(Rows.Count, 1).End(xlUp).offset(1, 0)
           .Resize(rng.rows.count,1).Value = sh.Name
           rng.resize(rng.rows.count, _
                      rng.EntireRow.columns.count-1).Copy .offset(0,1)
       End with

       End If
    Next

End Sub

Answer 2

Option Explicit

Sub ConsolidateWorkSheets()
    Dim ws1 As Worksheet, ws As Worksheet, rng As Range
    Dim sr As Long, lr As Long, lc As Long

    Set ws1 = Worksheets("Sheet1")
    For Each ws In Worksheets
        If ws.Name <> ws1.Name Then
            lr = ws.UsedRange.Rows.Count + 1
            Set rng = ws.Range("A9:A" & ws.Cells(lr, 1).End(xlUp).Row)
            sr = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row + 1
            rng.EntireRow.Copy ws1.Cells(sr, 1)
            lr = ws1.Cells(ws1.UsedRange.Rows.Count + 1, 1).End(xlUp).Row
            lc = ws1.Cells(1, ws1.UsedRange.Columns.Count + 1).End(xlToLeft).Column
            ws1.Range(ws1.Cells(sr, lc + 1), ws1.Cells(lr, lc + 1)).Value2 = ws.Name
        End If
    Next
End Sub

跟踪工作表

2 个答案: