VBA Copy and Paste Data from one workbook to another - specific columns

[jayped]

Hi,

I have a statement converted from pdf to excel. Unfortunately, the column headers above the data that I really need may lie on different rows, for e.g. row 17 or row 18. I have 3 columns I want to copy from the statement: Date (column B), Description (column C) and Amount (column D); then paste into another workbook beginning from row 6 into column A (Transaction Date), column B (Description of Expense) and column G (Receipt Amount). Can this be done using a VBA macro?

Thanks.

 

[JLGWhiz]

Maybe you can work with this and get what you want.

Sub t()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long
Set sh1 = Workbooks(1).Sheets(1)
Set sh2 = Workbooks(2).Sheets(2)
lr = sh1.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
    With sh1
       .Range("B19:B" & lr).Copy sh2.Cells(Rows.Count, 1).End(xlUp)(2)
       .Range("C19:C" & lr).Copy sh2.Cells(Rows.Count, 1).End(xlUp).Offset(, 1)
       .Range("D19:D" & lr).Copy sh2.Cells(Rows.Count, 1).End(xlUp).Offset(, 6)
    End With
End Sub

 

[jayped]

Hi Thank you for your reply. The dates in column B were not aligning with C & D when testing on a blank sheet so I moved that line to the third range and it was fixed. Not sure why it would do that.

My problem is that the Data is not pasting where I need it to. 'Sh2' has column headers laid out on row 5 from Columns A to I. How can I paste the data exactly under the headers in columns A, B and G on row 6?

Let's say too that instead of having to have Workbook 1 opened, I want the user to be able to browse and import the three ranges (B19:B, C19:C, D19:D) into Workbook 2. Can you help modify this code to accomplish this please? I will create a button which will 'update' sh2.

Thirdly, I want to paste values.

Thanks.

 

[JLGWhiz]

See if this works with the browse built in. The code will need to be in the workbook that is already open and active.

Sub t()
Dim wb As Workbook, sh1 As Worksheet, sh2 As Worksheet, lr As Long, fName As String
fName = Application.GetOpenFilename("Excel Files(*.xls*), *.xls*")
Set sh2 = ActiveSheet
Set wb = Workbooks.Open(fName)
Set sh1 = wb.Sheets(1)
lr = sh1.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
    With sh1
       .Range("B19:C" & lr).Copy
       sh2.Cells(6, 1).PasteSpecial xlPasteValues
       .Range("D19:D" & lr).Copy
       sh2.Cells(6, 7).PasteSpecial xlPasteValues
    End With
    wb.Close False
End Sub

 

[jayped]

Hi thank you for your reply. Sorry I am now only getting back to you but the solution worked.

However, is there a way to skip certain rows if column B contains the word "payment" when pasting?

Thanks.

 

[JLGWhiz]

I assume you mean column B of the Pasted range. It would be easier to eliminate those rows before copying. I assume that "Payment" would appear in column C of sheet 1. If you can confirm that, I can modify the code so that those rows are not copied.

 

[jayped]

Yes, payment would appear in column C of sheet 1.

 

[JLGWhiz]

See if this works OK.

Sub t()
Dim wb As Workbook, sh1 As Worksheet, sh2 As Worksheet, lr As Long, fName As String
fName = Application.GetOpenFilename("Excel Files(*.xls*), *.xls*")
Set sh2 = ActiveSheet
Set wb = Workbooks.Open(fName)
Set sh1 = wb.Sheets(1)
lr = sh1.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
    With sh1
        .UsedRange.AutoFilter 3, "<>" & "Payment"
       .Range("B19:C" & lr).Copy
       sh2.Cells(6, 1).PasteSpecial xlPasteValues
       .Range("D19:D" & lr).Copy
       sh2.Cells(6, 7).PasteSpecial xlPasteValues
       .AutoFilterMode = False
    End With
    wb.Close False
End Sub

 

[jayped]

Awesome. Thank you.

 

[JLGWhiz]

You're welcome,
Regards, JLG