Copy data from one workbook to another while performing a check

Question

Completely new to VBA. But here is the code I have. The first code box is to perform a check that Cell X in Workbook1 equals Cell Y in Workbook2, if successful it will continue to my second code box where it will pull the data from the designated cells and then paste it in the row where the active cell is currently located. The second code box needs an overhaul to designate the paste function into the active row, starting at the active cell.

I get errors trying to get the row where the active cell is currently located.

Here's the flow..

Command Button Click
Select File with data to be copied from (this workbook has static cells so data is being pulled from the same cell regardless of which spreadsheet is being used)
Perform a check that workbook1 process number (static cell) matches process number in workbook 2 in the current row where active cell is located (same column, changing rows)

4a. Success- Proceed to copy and paste data into active row beginning at the active cell

4b. Fail- Error message and don't copy or paste.

Code:

Sub Foo()
 Dim vFile As Variant
 Dim wbCopyTo As Workbook
 Dim wsCopyTo As Worksheet
 Dim wbCopyFrom As Workbook
 Dim wsCopyFrom As Worksheet

 Set wbCopyTo = ActiveWorkbook
 Set wsCopyTo = ActiveSheet

     '-------------------------------------------------------------
     'Open file with data to be copied

     vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
     "*.xl*", 1, "Select Excel File", "Open", False)

     'If Cancel then Exit
     If TypeName(vFile) = "Boolean" Then
         Exit Sub
     Else
     Set wbCopyFrom = Workbooks.Open(vFile)
     Set wsCopyFrom = wbCopyFrom.Worksheets(1)
     End If

'Process number check to see if values match and the data is being put in the correct row

Dim projectNumber As Long
Dim column As Integer  
Dim row As Integer
Dim rng As Range

'Set column and row to whatever row/column contains the Project Number in wsCopyFrom (could also use Range if its a particular cell)
projectNumber = wsCopyFrom.Range("G5).Value

Set rng = wsCopyTo.Cells.EntireRow.Select 'Get selected row in Active Worksheet
For Each c In rng.Cells    ' Check each cell in row/range
    If c.Value = projectNumber   ' Project number was found
        MsgBox("Project number found!")

        ' Insert copy and pasting code here.... See below code box

    End If
Next c

' Project number was not found in selected range if you get to this point
 MsgBox("Project Number Does Not Match")


'Close file that was opened
     wbCopyFrom.Close SaveChanges:=False

Code:

'Copy and Pasting

 wsCopyFrom.Range("F21").Copy
 wsCopyTo.Range("Active Row, beginning at Active Cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 wsCopyFrom.Range("G21").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 wsCopyFrom.Range("L21").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 wsCopyFrom.Range("M21").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 wsCopyFrom.Range("R21").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 wsCopyFrom.Range("S21").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 wsCopyFrom.Range("G31").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 wsCopyFrom.Range("M31").Copy
 wsCopyTo.Range(""Active Row and Offset one column to the right from previous cell).PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 wsCopyFrom.Range("S31").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 wsCopyFrom.Range("F41").Copy
 wsCopyTo.Range(""Active Row and Offset one column to the right from previous cell).PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 wsCopyFrom.Range("G41").Copy
 wsCopyTo.Range("Active Row and Offset one column to the right from previous cell").PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False

OMGSOMETAL OMGSOMETAL · Accepted Answer · 2018-05-24T22:06:44

If what you want is to copy from 1 file and paste it on another file without pasting it over already existing content then you should opt for a VBscript instead of excel.

Example below:

    strPathSrc = "C:\......" ' Source files folder
strMaskSrc = "*.csv" ' Source files filter mask can be any format
iSheetSrc = 3 ' Source sheet index or name sheet you want to copy
strPathDst = "C:\....xlsx" ' Destination file
iSheetDst = 1 ' Destination sheet index or name

Set objExcel = CreateObject("Excel.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
objExcel.Visible = false
Set objWorkBookDst = objExcel.Workbooks.Open(strPathDst)
Set objSheetDst = objWorkBookDst.Sheets(iSheetDst)
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.NameSpace(strPathSrc)
Set objItems = objFolder.Items()
objItems.Filter 64 + 128, strMaskSrc
objExcel.DisplayAlerts = False
For Each objItem In objItems
    Set objWorkBookSrc = objExcel.Workbooks.Open(objItem.Path)
    Set objSheetSrc = objWorkBookSrc.Sheets(iSheetSrc)
    GetUsedRange(objSheetSrc).Copy
    Set objUsedRangeDst = GetUsedRange(objSheetDst)
    iRowsCount = objUsedRangeDst.Rows.Count
    objWorkBookDst.Activate
    objSheetDst.Cells(iRowsCount + 1, 1).Select
    objSheetDst.Paste
    objWorkBookDst.Application.CutCopyMode = False
    objWorkBookSrc.Close

Next
objExcel.ActiveWorkbook.Save
fso.DeleteFile "C:......", True 'delete original file if required
Function GetUsedRange(objSheet)
    With objSheet
        Set GetUsedRange = .Range(.Cells(1, 1), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, .UsedRange.Column + .UsedRange.Columns.Count - 1))
    End With
End Function

Paste this into a notepad and save it as .vbs then run it and should have you sorted. you can even automate this with windows scheduler if necessary.

Hope it helps

Copy data from one workbook to another while performing a check

1 Answers