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.

 

[jayped]

You're welcome,
Regards, JLG

Hi there,

I was wondering if I'd be able to build on the macro above to insert rows between rows 6 and 20 on the active workbook if the number of rows with data on the statement which I'm copying from exceeds this. Is it possible?

This is because on the active workbook below row 20 there is already data there.

 

[JLGWhiz]

I t is customary to start a new thread instead of piggy backing on an old one when a user has an after thought aabout their original post and the original post is several months old, You should adhere to that principal in the future. Here is the mod to compensate for rows exceeding the available space.

Sub t2()
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"
    cnt = .UsedRange.SpecialCells(xlCellTypeVisble) = 1
    If cnt <= 15 Then
        .Range("B19:C" & lr).Copy
        sh2.Cells(6, 1).PasteSpecial xlPasteValues
        .Range("D19:D" & lr).Copy
        sh2.Cells(6, 7).PasteSpecial xlPasteValues
        .AutoFilterMode = False
    Else
        sh2.Rows(6).Resize(cnt + 1 - 15).EntireRow.Insert
        .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 If
End With
wb.Close False
End Sub

 

[jayped]

I t is customary to start a new thread instead of piggy backing on an old one when a user has an after thought aabout their original post and the original post is several months old, You should adhere to that principal in the future. Here is the mod to compensate for rows exceeding the available space.

Sub t2()
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"
    cnt = .UsedRange.SpecialCells(xlCellTypeVisible) = 1
    If cnt <= 15 Then
        .Range("B19:C" & lr).Copy
        sh2.Cells(6, 1).PasteSpecial xlPasteValues
        .Range("D19:D" & lr).Copy
        sh2.Cells(6, 7).PasteSpecial xlPasteValues
        .AutoFilterMode = False
    Else
        sh2.Rows(6).Resize(cnt + 1 - 15).EntireRow.Insert
        .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 If
End With
wb.Close False
End Sub

Apologies for not following the custom and I'll make sure to post a new thread but thank you nonetheless for helping. I am having an error at this point. It says 'type mismatch'.

cnt = .UsedRange.SpecialCells(xlCellTypeVisible) = 1

 

[JLGWhiz]

Apologies for not following the custom and I'll make sure to post a new thread but thank you nonetheless for helping. I am having an error at this point. It says 'type mismatch'.

cnt = .UsedRange.SpecialCells(xlCellTypeVisible) = 1

Change the equal symbol to a minus (-) symbol. My butterfingers hit the wrong key.

 

[jayped]

Change the equal symbol to a minus (-) symbol. My butterfingers hit the wrong key.

I still get the type mismatch error

 

[JLGWhiz]

I am not sure what I was thinking at the time wrote that line of code, but you can see if this works. If not, I suggest you start a new thread and let somebody else take a shot at it.

cnt = .UsedRange.SpecialCells(xlCellTypeVisble) . Count - 1

 

[jayped]

I am not sure what I was thinking at the time wrote that line of code, but you can see if this works. If not, I suggest you start a new thread and let somebody else take a shot at it.

cnt = .UsedRange.SpecialCells(xlCellTypeVisble) . Count - 1

Hi.

Sorry, that didn't seem to work the way I needed. It was counting cells instead of rows and even when I tried to work with it counted a number that I couldn't make sense of so I ended up with this:

cnt = .UsedRange.Resize(, 1).SpecialCells(xlCellTypeVisible).Count - 1

I think it works perfectly now. Thank you for your help.