SkywardPalm
Board Regular
- Joined
- Oct 23, 2021
- Messages
- 61
- Office Version
- 365
- Platform
- Windows
I have VBA code that pulls the column data from one workbook into another, and it pulls all but the last two columns based on headers.
The last two columns are both price columns that could be formulas.. the values are not pasting into the destination, though. Is there something I could be doing better or may be missing to pull this data?
VBA Code:
Sub Import_Data()
' Name Type Description
'==================================================================================================
Dim wbCurrent As Workbook ' Current workbook
Dim wksCurrent As Worksheet ' Current sheet
Dim rCurrentColHeaders As Range ' Current column headers
Dim rCurVarColHeaders As Range ' Current Variance column headers (which will be searched through)
Dim rColHead As Range ' Iterates through the Imported column headers
Dim rMatchColHead As Range ' Gets the matching Variance column header
Dim iNumCellsPerColumn As Long ' Defines how many cells per column we're copying
Dim CurrentFileToOpen As Variant
' init
'==========================================
' headers
Set rCurVarColHeaders = ThisWorkbook.Worksheets("Current").Range("A1:O1")
ThisWorkbook.Worksheets("Current").Rows("2:" & Rows.Count).ClearContents
ThisWorkbook.Worksheets("Variance").Rows("2:" & Rows.Count).ClearContents
'
'
' Import Current Master Data
'
CurrentFileToOpen = Application.GetOpenFilename(Title:="Browse for Current Draft File", FileFilter:=" Excel Files(*.xls*),*xls*")
If CurrentFileToOpen <> False Then
Set wbCurrent = Application.Workbooks.Open(CurrentFileToOpen)
Set wksCurrent = wbCurrent.Worksheets("Master")
Set rCurrentColHeaders = wksCurrent.Range("A1:AZ1")
' set number of cells to copy per column (change to suit your needs)
With wbCurrent.Worksheets("Master")
iNumCellsPerColumn = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
' process
'==========================================
' - loop through the Current column header cells
' -- try to find the matching column
' -- if a match is found, copy column cells from the Current to the Variance
For Each rColHead In rCurrentColHeaders
Set rMatchColHead = rCurVarColHeaders.Find(rColHead.Text, , xlValues, xlWhole)
If Not (rMatchColHead Is Nothing) Then
wksCurrent.Range(rColHead, rColHead.Offset(iNumCellsPerColumn, 0)).Copy
rMatchColHead.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Else
Debug.Print rColHead & " Header Not Found"
End If
Next rColHead
wbCurrent.Close False
End If
End SubThe last two columns are both price columns that could be formulas.. the values are not pasting into the destination, though. Is there something I could be doing better or may be missing to pull this data?
