将多个工作表中的特定列复制为一个

时间:2016-04-24 14:29:14

标签: vba excel-vba excel

我是VBA的新手。我一直在寻找几个小时但无济于事:(

我有12张由A-T列组成的纸张。我想通过使用宏将12张表中的每一张中的C和T列复制并组合成一个工作簿“摘要”。有人能帮我吗?提前谢谢。

Sub Create_Summary()

Application.DisplayAlerts = False
On Error Resume Next

Application.DisplayAlerts = True
 n = Application.Worksheets.Count

Sheets("Summary").Move after:=Worksheets(Worksheets.Count)

Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
   If sh.Name <> "Summary" Then
    Set col = Columns(Columns.Count).End(xlToLeft)
      Set col = Columns(Columns.Count).End(xlToLeft)
        sh.Range("C:C,T:T").Copy Destination:=Sheets("Summary").Range(col,col)
    End If

Next sh

End Sub

这个副本的C和T列来自最后一张,而其他的只是C而没有T。

1 个答案:

答案 0 :(得分:1)

试试这个

Option Explicit

Sub Create_Summary()
Dim sh As Worksheet, sumSht As Worksheet
Dim i As Long

Set sumSht = Sheets("Summary")
sumSht.Move after:=Worksheets(Worksheets.Count)

For i = 1 To Worksheets.Count - 1 ' once you moved "Summary" sheet as the workbook last one, you skip it by limiting loop to the penultimate sheets index
    Worksheets(i).Range("C:C,T:T").Copy Destination:=sumSht.Cells(1, sumSht.Columns.Count).End(xlToLeft).Offset(, 1) ' qualify all destination references to "Summary" sheet
Next i
sumSht.Columns(1).Delete ' "Summary" sheet first column gest skipped by the above loop, so delete it

End Sub

它已被评论,以便您可以关注它并进行改变