循环浏览工作表以复制/粘贴到命名工作表

Question

以下代码未循环复制到＆＃34;存档＆＃34;片。另外，我希望它能在档案表中的A列和A栏中添加今天的日期和工作表名称。

Sub ArchiveTrans()
Dim ws As Worksheet
Dim LastRow As Long
Dim SourceWB As Workbook

Application.ScreenUpdating = False

'Select source location and range
For Each ws In SourceWB.Worksheets
    If ws.Name <> "Change Control" And ws.Name <> "Archive" Then
        ActiveSheet.Select
        Set destRng = Sheets("Archive").Cells(Rows.Count, "C").End    (xlUp).Offset(1, 0)

'Copy selected range to last row
LastRow = Range("B" & Rows.Count).End(xlUp).Row
Range("A:AK" & LastRow).Copy Destination:=destRng

    End If
Next ws
With Application
    .CutCopyMode = False
    .ScreenUpdating = True
  End With
End Sub