时间戳

首页 > 解决方案 > VBA 不复制整行，缺少一列

excel - VBA 不复制整行，缺少一列

问题描述

有点奇怪。我有一个包含大量信息的文件，该文件最多可以到达“CH”列。工作簿中的信息分布在多个选项卡中，当我合并数据时，它会复制除最后一列之外的所有内容。想知道你能不能帮我

Sub consolidation()

Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidation").Delete
Application.DisplayAlerts = True

With ActiveWorkbook
    Set Destination = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    Destination.Name = "Consolidation"
End With


Dim i As Integer

Dim stOne As Worksheet
Dim stOneLastRow As Long

Dim stTwo As Worksheet
Dim stTwoLastRow As Long

Dim consolid As Worksheet
Dim consolidLastRow As Long

Set stOne = ThisWorkbook.Sheets("Sheet1")
Set stTwo = ThisWorkbook.Sheets("Sheet2")
Set consolid = ThisWorkbook.Sheets("Consolidation")


stOneLastRow = stOne.Range("C" & Rows.Count).End(xlUp).Row
stTwoLastRow = stTwo.Range("C" & Rows.Count).End(xlUp).Row
consolidLastRow = consolid.Range("C" & Rows.Count).End(xlUp).Row


For i = 6 To stOneLastRow
stOne.Select


If stOne.Range("C6").Value = "OM ID" Then

Cells(i, 3).Resize(1, 100).Copy
consolid.Select
NextRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Cells(NextRow, 2).Select
ActiveSheet.Paste
stOne.Select

End If

Next i

For i = 7 To stTwoLastRow
stTwo.Select


If stTwo.Range("C6").Value = "OM ID" Then

Cells(i, 3).Resize(1, 100).Copy
consolid.Select
NextRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Cells(NextRow, 2).Select
ActiveSheet.Paste
stTwo.Select

End If

Next i

End Sub

初始代码取自这里：https ://docs.microsoft.com/en-us/office/vba/api/excel.range.copy

尝试根据 CH 单元格中的值复制行，但仍复制除该列之外的所有内容...

很奇怪 ：-（

标签： excelvbaautomation

解决方案

天啊……我觉得好傻。数据从第 3 列开始，但我从第 2 列开始复制所有内容...宏工作正常，只需要更改列...

推荐阅读