试图粘贴一系列细胞

Question

我正在使用一个循环来选择一系列细胞，但我没有得到一个范围，相反，我只得到两个细胞。

我在这里的数据的屏幕截图：

Sub CellWidthAnalysis()

Dim pastecounter As Integer
Dim collength As Integer
Dim colnumber As Integer

'assign counters

pastecounter = 1 'for pasting in correct column
collength = 1  'for keeping track of column length
colnumber = 2       'for number of columns

ActiveSheet.Cells(3, 1).Select
'Now to select first column of data
If colnumber = 2 Then
        Do Until ActiveCell.Value = "Image Name"
            ActiveCell.Offset(1, 0).Select
            collength = collength + 1
        Loop
        Range(Cells(collength, 1), Cells(collength, 2)).Select
        Selection.Copy
        Sheets("Sheet2").Select
        Cells(1, 1).Select
        ActiveCell.Offset(2, pastecounter).Select
        ActiveSheet.Paste
        pastecounter = pastecounter + 5
        colnumber = colnumber + 1
Else
End If

我认为这与我的强力计数器有关 - 我不知道为什么会这样。它应该计算偏移量吗？

但每次粘贴只是A＃和B＃（图像名称字符串之前的单元格）而不是（3,1）和（3,2）之间的范围以及图像名称之前的单元格。

感谢您的任何想法！

Answer 1

您的Range()错误出现在您为副本选择的Sub CellWidthAnalysis() Dim pastecounter As Integer Dim collength As Integer Dim colnumber As Integer 'assign counters pastecounter = 1 'for pasting in correct column collength = 1 'for keeping track of column length colnumber = 2 'for number of columns ActiveSheet.Cells(3, 1).Select 'Now to select first column of data If colnumber = 2 Then Do Until ActiveCell.Value = "Image Name" ActiveCell.Offset(1, 0).Select collength = collength + 1 Loop 'the difference is here: Range(Cells(2, 1), Cells(collength, 2)).Copy Sheets("Sheet2").Cells(1, 1).Offset(2, pastecounter).Paste pastecounter = pastecounter + 5 colnumber = colnumber + 1 End If 中。试试这个：

Cells()

这是至关重要的变化：

• 您通过将相同的行传递给两个.select引用来定义范围，从而获得2列宽1行高的范围。我将其更改为使用第2行作为起点。如果需要更改，您将要在其中替换变量。

关于代码的一些一般性说明：

1. 我取消了selection.copy和.select。用一个
替换2行代码
2. 我也删除了.paste指令中的所有If colnumber = 2 Then内容。简化事情
3. 我不确定colnumber=2结构的价值。您指定{{1}}，然后立即检查它是否仍然是2.除非您当然删除了一些可能会更改该值的循环代码以简化您的示例。