# Modify existing VBA to transfer data over



## ItalianPlatinum (Dec 19, 2022)

Hello - I have existing VBA that works as intended transferring data over to another sheet. i have to add a 2nd occurrence of a transfer from another sheet. Therefore I am having difficulty to transfer over to the next open row of the destination sheet. is anyone also to assist?



```
Sub ImportFILE()
    Dim vCols As Variant, vRows As Variant
    Dim i As Long, k As Long
    
'Fomulas for Review (PD File)
With WsSPT1
'worksheet ETC formulas, filters, column mods'
End With

'transfer PD data over to Compare tab
  vCols = Array(1, 2, 3, 4, 8, 9, 10, 11) '<- Columns of interest in specified order
  With WsSPCT
    With .Range("A1:K" & .Range("H" & rows.count).End(xlUp).row)
        If .rows.count > 2 Then
            vRows = Application.Index(.Cells, Evaluate("row(1:" & .rows.count & ")"), Array(8, 3))
            For i = 3 To UBound(vRows)
                If Len(vRows(i, 1)) > 0 And UCase(vRows(i, 2)) <> "" Then
                    k = k + 1
                    vRows(k, 1) = i
        End If
      Next i
      WsDIST.Range("A2").Resize(k, UBound(vCols) + 1).Value = Application.Index(.Cells.Value, Application.Index(vRows, 0, 1), vCols)
      Else
        MsgBox "No data to transfer"
      End If
    End With
  End With

'Fomulas for Review (CD File)
With WsSPT
'worksheet ETC formulas, filters, column mods'
End With

'NEED HELP ON THIS! transfer CD data over to Compare tab BELOW PD data
  vCols = Array(1, 2, 3, 4, 8, 9, 10, 11) '<- Columns of interest in specified order
  With WsSPT
    With .Range("A1:K" & .Range("H" & rows.count).End(xlUp).row)
        If .rows.count > 2 Then
            vRows = Application.Index(.Cells, Evaluate("row(1:" & .rows.count & ")"), Array(8, 3))
            For i = 3 To UBound(vRows)
                If Len(vRows(i, 1)) > 0 And UCase(vRows(i, 2)) <> "" Then
                    k = k + 1
                    vRows(k, 1) = i
        End If
      Next i
      WsDIST.Range("A2").Resize(k, UBound(vCols) + 1).Value = Application.Index(.Cells.Value, Application.Index(vRows, 0, 1), vCols)
      Else
        MsgBox "No data to transfer"
      End If
    End With
  End With
```


----------



## Peter_SSs (Dec 20, 2022)

Since you have now continued with this in the old thread I'm closing this one.


----------

