简体   繁体   中英

VBA Does not copy the entire row, missing one column

a bit of an odd one. I have a file with large amount of info that goes up to column "CH". Information in the workbook is spread through multiple tabs and when I consolidate data it copies everything except for the last column. Wonder if you could help me with that

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

Initial code is taken from here: https://docs.microsoft.com/en-us/office/vba/api/excel.range.copy

Tried to copy rows based on the value in CH cell, but still copies everything except for that column...

Very weird:-(

Omg... I feel so stupid. The data starts from 3rd column, but I copied everything starting from the 2nd colum... macro works correctly, just needed to change the column...

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM