每次合并新工作表时如何向Excel工作表添加计数器？

Question

如何为每个新工作表合并添加计数器？ 红色是第一张纸组合机黄色是第二张纸组合机绿色是第三张纸组合机

不需要添加颜色....但是我一直在尝试添加一个计数器，但是我不知道该怎么做...并将其放置在每个导入的数据上方

这可能是我错误地使用宏的方式...

希望有人帮助我....

图片

Sub GetSheets()'Update Excel Junction.com
Path = "C:\Users\momo\Desktop\Miscellaneous Shipment Packing List\New folder\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

Sub CombineDataFromAllSheets()

Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long

'Notes: "Src" is short for "Source", "Dst" is short for "Destination"

'Set references up-front
Set wksDst = ThisWorkbook.Worksheets("Combine")
lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)!
lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)!

'Set the initial destination range
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 2)



'Loop through all sheets
For Each wksSrc In ThisWorkbook.Worksheets

    'Make sure we skip the "Import" destination sheet!
    If wksSrc.Name <> "Combine" Then

        'Identify the last occupied row on this sheet
        lngSrcLastRow = LastOccupiedRowNum(wksSrc)

        'Store the source data then copy it to the destination range
        With wksSrc
            Set rngSrc = .Range(.Cells(2, 6), .Cells(lngSrcLastRow, lngLastCol))
            rngSrc.Copy Destination:=rngDst
        End With

        'Redefine the destination range now that new data has been added
        lngDstLastRow = LastOccupiedRowNum(wksDst)
        Set rngDst = wksDst.Cells(lngDstLastRow + 2, 1)
    End If
Next wksSrc
End Sub


'''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last row
'OUTPUT      : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
    End With
Else
    lng = 1
End If
LastOccupiedRowNum = lng
End Function


''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last column
'OUTPUT      : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
    With Sheet
        lng = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByColumns, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Column
    End With
Else
    lng = 1
End If
LastOccupiedColNum = lng
End Function

Answer 1

最简单的方法是添加一个静态计数器，但是每次您打开工作簿时，它将重置。 更具弹性的方法是找到最后一个计数器并添加一个。

我无法在此处创建经过全面测试的代码，但以下内容应能提供足够的帮助。 请记住，适当的缩进和Option Explicit是您的朋友。 另外，我没有在代码中进行任何其他优化-例如，检查您真正需要设置目标范围的次数以及最好在哪里进行设置。

Sub CombineDataFromAllSheets()
Dim importCounter as Long '**** Added this 
Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
    'Notes: "Src" is short for "Source", "Dst" is short for "Destination"
    'Set references up-front
    Set wksDst = ThisWorkbook.Worksheets("Combine")
    lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)!
    lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)!

    'Set the initial destination range
    Set rngDst = wksDst.Cells(lngDstLastRow + 1, 2)

    '**** Find and set the Counter - not tested for error conditions (what if the sheet is empty?)
    importCounter = wksDst.Cells(Range("A" & lngDstLastRow).End(xlUp).Row,1)

    'Loop through all sheets
    For Each wksSrc In ThisWorkbook.Worksheets

        'Make sure we skip the "Import" destination sheet!
        If wksSrc.Name <> "Combine" Then

            'Identify the last occupied row on this sheet
            lngSrcLastRow = LastOccupiedRowNum(wksSrc)

            'Store the source data then copy it to the destination range
            With wksSrc
                '**** increment and insert the counter
                '**** in order to do this, had to fix rngDst, set it where it is used rather then too early.
                Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
                importCounter = importCounter + 1
                rngDst = importCounter
                lngDstLastRow = lngDstLastRow  + 1
                Set rngDst = wksDst.Cells(lngDstLastRow + 1, 2)

                Set rngSrc = .Range(.Cells(2, 6), .Cells(lngSrcLastRow, lngLastCol))
                rngSrc.Copy Destination:=rngDst
            End With

            'Redefine the destination range now that new data has been added
            lngDstLastRow = LastOccupiedRowNum(wksDst)
            Set rngDst = wksDst.Cells(lngDstLastRow + 2, 1)
        End If
    Next wksSrc
End Sub