我有大约30个工作表,每个工作表有20多列,行数很多。如何告诉Excel选择包含每个工作表第二行中文本的最后一列并将它们放在新工作表中?以下代码似乎很接近:
Sub CopyRange()
Dim bottomD As Integer
Dim ws As Worksheet
For Each ws In Sheets(Array("A", "B", "C", "D"))
ws.Activate
bottomD = Range("D" & Rows.Count).End(xlUp).Row
Range("A2:D" & bottomD).Copy Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Next ws
End Sub
而不是bottomD = Range("D" & Rows.Count).End(xlUp).Row
我应该能够使用像furthest = Range(Columns.Count & "2").End(xlRight).Column
这样的东西。我有几个问题:
1)我的第一次改变是否有意义?
2)有没有办法让宏观察循环而不是Sheets(Array("A", "B", "C", "D"))
?在我的情况下,工作表都具有相似的名称,因此可以简单地枚举工作表编号i的Array("Name" & i)
。
答案 0 :(得分:1)
可以使用Worksheets集合中的索引访问循环中的工作表。请参阅下面的代码。
除非您使用的是16位计算机,否则请使用数据类型Long
而不是Integer
。 Integer
指定一个16位数字,在32位计算机上需要特殊处理。此外,对于Excel 2007及更高版本,Integer
不足以容纳更大的行号。
避免激活工作表,因为它是一个缓慢的命令。如果必须激活工作表,请包括
Application.ScreenUpdating = False
每次切换工作表时,会减少屏幕闪烁,因为屏幕重新绘制,
furthest = Range(Columns.Count & "2").End(xlRight).Column
是正确的想法,但实施是错误的。 Columns.Count
返回您的Excel版本的列数。对于Excel 2003,有256列。更高版本有16384列。因此,您要指定Range(2562)
或Range(163842)
。请参阅下面的代码以获取正确的语法。
我不明白Range("A2:D" & bottomD).Copy Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
您说要复制列,但Range("A2:D" & bottomD)
不是列。然后,您将所有源列放在工作表“摘要”的A列中。这真的是你想要的吗?在下面的代码中,我将源列放在由工作表名称为首的工作表中,我认为这是一个更有用的安排。如果这不是您想要的,我可以调整代码以提供您想要的结果。
Option Explicit
Sub MergeColumns()
Dim ColSrcCrnt As Long
Dim ColSumCrnt As Long
Dim InxWsht As Long
Dim RowSrcLast As Long
Dim WshtSum As Worksheet
Set WshtSum = Worksheets("Summary")
' Clear existing contents
WshtSum.Cells.EntireRow.Delete
ColSumCrnt = 1
For InxWsht = 1 To Worksheets.Count
With Worksheets(InxWsht)
If .Name <> "Summary" Then
' Write worksheet name to row 1 of current column of "Summary"
WshtSum.Cells(1, ColSumCrnt).Value = .Name
' This worksheet is not the summary so find the last
' column with a value in row 2.
ColSrcCrnt = .Cells(2, Columns.Count).End(xlToLeft).Column
If .Cells(Rows.Count, ColSrcCrnt).Value <> "" Then
' Bottom cell of column used. It will be lost. Colour
' worksheet name to report error.
WshtSum.Cells(1, ColSumCrnt).Font.Color = RGB(255, 0, 0)
RowSrcLast = Rows.Count - 1
Else
' There is room for entire column in Summary
RowSrcLast = .Cells(Rows.Count, ColSrcCrnt).End(xlUp).Row
End If
' Copy column
.Range(.Cells(1, ColSrcCrnt), _
.Cells(RowSrcLast, ColSrcCrnt)).Copy Destination:=WshtSum.Cells(2, ColSumCrnt)
ColSumCrnt = ColSumCrnt + 1 ' Step ready for next worksheet
End If
End With
Next
End Sub