尝试粘贴一系列单元格

Question

我正在使用一个循环来 select 一系列单元格，但我没有得到一个范围，相反，我只得到了两个单元格。

我这里的数据截图：

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

我认为这与我的 collength 计数器有关 - 我不确定为什么。它应该和偏移量一起计算吧？

但每次粘贴只是 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() 引用来定义范围，从而获得 2 列宽乘 1 行高的范围。我将其更改为使用第 2 行作为起点。如果需要更改，您需要在其中替换一个变量。

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

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

尝试粘贴一系列单元格

Trying to paste a range of cells

vba

excel

excel-2010