Extracting data from one workbook and pasting in another with comments - vba

Question

I would like to copy the data from one workbook to another.
My source workbook has some comments listed in each row. When I use my code to copy, it does not copy the comments accordingly. Could any one help, how I could copy from one workbook to another with the comment field ? my comments are in Column P.
Sub Extract()
Dim DestinationWB As Workbook
Dim OriginWB As Workbook
Dim path1 As String
Dim FileWithPath As String
Dim lastRow As Long, i As Long, LastCol As Long
Dim TheHeader As String
Dim cell As Range
Set DestinationWB = ThisWorkbook
path1 = DestinationWB.Path
FileWithPath = path1 & "\Downloads\CTT.xlsx"
Set OriginWB = Workbooks.Open(filename:=FileWithPath)
lastRow = OriginWB.Worksheets("Report").Cells(Rows.count, 1).End(xlUp).Row
LastCol = OriginWB.Worksheets("Report").Cells(22, Columns.count).End(xlToLeft).Column
For i = 1 To LastCol
'get the name of the field (names are in row 22)
TheHeader = OriginWB.Worksheets("Report").Cells(22, i).Value
With DestinationWB.Worksheets("CTT").Range("A4:P4")
'Find the name of the field (TheHeader) in the destination (in row 4)
Set cell = .Find(TheHeader, LookIn:=xlValues)
End With
If Not cell Is Nothing Then
OriginWB.Worksheets("Report").Range(Cells(23, i), Cells(lastRow, i)).Copy Destination:=DestinationWB.Worksheets("CTT").Cells(5, cell.Column)
Else
'handle the error
End If
Next i
OriginWB.Close SaveChanges:=False
End Sub

Answer 1

I refactored your code correcting the unqualified references and printing the Source and Destination range addresses to the Immediate window. This should give you an idea of what is going on.
Sub Extract()
Dim DestinationWB As Workbook
Dim OriginWB As Workbook
Dim FileWithPath As String, path1 As String, TheHeader As String
Dim lastRow As Long, col As Long
Dim cell As Range, Source As Range
Set DestinationWB = ThisWorkbook
path1 = DestinationWB.Path
FileWithPath = path1 & "\Downloads\CTT.xlsx"
Set OriginWB = Workbooks.Open(Filename:=FileWithPath)
With OriginWB.Worksheets("Report")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For col = 1 To .Cells(22, .Columns.Count).End(xlToLeft).Column
'get the name of the field (names are in row 22)
TheHeader = OriginWB.Worksheets("Report").Cells(22, col).Value
With DestinationWB.Worksheets("CTT").Range("A4:P4")
'Find the name of the field (TheHeader) in the destination (in row 4)
Set cell = .Find(TheHeader, LookIn:=xlValues)
End With
If Not cell Is Nothing Then
Set Source = .Range(.Cells(23, col), .Cells(lastRow, col))
Source.Copy Destination:=cell.Offset(1)
Debug.Print Source.Address(External:=True), "Copied to ", cell.Offset(1).Address(External:=True)
Else
'handle the error
End If
Next
End With
OriginWB.Close SaveChanges:=False
End Sub