VBA Help

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

All,

I have a two workbooks I want to copy data from one to the other using VBA.
What I need is a macro to find specific row labels in one work sheet and
paste the corresponding data in the second worksheet.

Any help is appreciated.

thanks,

RK
 
OK.
I have data in lets say workbook1 in sheet1. Columns are labeled x, y, and
z. I want to import this data to say workbook2 in sheet2. Columns in sheet2
are labeled a, b, c, x, y, and z. Now I want to make sure that the data that
i am copying over is pasted in the right columns labeled x, y, z and columns
labeled a, b, c should be all empty.
thanks much.

RK
 
Public Sub importWorkbook1()
Const strWorkbookName As String = "workbook1.xls"
Const strWorksheetName As String = "Sheet1"
Const strMasterWorksheet As String = "Sheet2"
Const iHeaderRow As Long = 1

Dim wkbSource As Excel.Workbook
Dim wshSource As Excel.Worksheet
Dim wshDest As Excel.Worksheet
Dim rngHeaders As Excel.Range
Dim rngMyHeaders As Excel.Range
Dim rngCopyRange As Excel.Range
Dim rngCurrentCell As Excel.Range

Dim iColumn As Long
Dim iMasterCol As Long
Dim calcs As Excel.XlCalculation

Application.ScreenUpdating = False
calcs = Application.Calculation
Application.Calculation = xlCalculationManual

Set wkbSource = Application.Workbooks.Open(ThisWorkbook.Path & _
IIf(Right$(ThisWorkbook.Path, 1) <> "\", "\", "") &
strWorkbookName)
Set wshSource = wkbSource.Worksheets(strWorksheetName)
Set wshDest = ThisWorkbook.Worksheets(strMasterWorksheet)

With wshSource
Set rngHeaders = Intersect(.UsedRange, .Rows(iHeaderRow))
Set rngMyHeaders = Intersect(wshDest.UsedRange, wshDest.Rows(1))

For iColumn = 1 To rngHeaders.Columns.Count
Set rngCurrentCell = .Cells(rngHeaders.Row, iColumn)
Debug.Print rngCurrentCell.Value
iMasterCol = rngMyHeaders.Find(rngCurrentCell.Value).Column
Set rngCopyRange = .Range(.Cells(rngHeaders.Row + 1, iColumn), _
.Cells(Application.WorksheetFunction.CountA( _
rngCurrentCell.EntireColumn) - 1, iColumn))
Debug.Print rngCopyRange.Address
rngCopyRange.Copy (wshDest.Cells(2, iMasterCol))
Next iColumn
End With


wkbSource.Saved = True
wkbSource.Close
Application.ScreenUpdating = True
Application.Calculation = calcs
End Sub
 
Man! I just can't get any of these right the first time...


Replace this line:

rngCopyRange.Copy (wshDest.Cells(2, iMasterCol))


With this:

rngCopyRange.Copy (wshDest.Cells(iHeaderRow + 1, iMasterCol))
 
thanks much iliace

iliace said:
Public Sub importWorkbook1()
Const strWorkbookName As String = "workbook1.xls"
Const strWorksheetName As String = "Sheet1"
Const strMasterWorksheet As String = "Sheet2"
Const iHeaderRow As Long = 1

Dim wkbSource As Excel.Workbook
Dim wshSource As Excel.Worksheet
Dim wshDest As Excel.Worksheet
Dim rngHeaders As Excel.Range
Dim rngMyHeaders As Excel.Range
Dim rngCopyRange As Excel.Range
Dim rngCurrentCell As Excel.Range

Dim iColumn As Long
Dim iMasterCol As Long
Dim calcs As Excel.XlCalculation

Application.ScreenUpdating = False
calcs = Application.Calculation
Application.Calculation = xlCalculationManual

Set wkbSource = Application.Workbooks.Open(ThisWorkbook.Path & _
IIf(Right$(ThisWorkbook.Path, 1) <> "\", "\", "") &
strWorkbookName)
Set wshSource = wkbSource.Worksheets(strWorksheetName)
Set wshDest = ThisWorkbook.Worksheets(strMasterWorksheet)

With wshSource
Set rngHeaders = Intersect(.UsedRange, .Rows(iHeaderRow))
Set rngMyHeaders = Intersect(wshDest.UsedRange, wshDest.Rows(1))

For iColumn = 1 To rngHeaders.Columns.Count
Set rngCurrentCell = .Cells(rngHeaders.Row, iColumn)
Debug.Print rngCurrentCell.Value
iMasterCol = rngMyHeaders.Find(rngCurrentCell.Value).Column
Set rngCopyRange = .Range(.Cells(rngHeaders.Row + 1, iColumn), _
.Cells(Application.WorksheetFunction.CountA( _
rngCurrentCell.EntireColumn) - 1, iColumn))
Debug.Print rngCopyRange.Address
rngCopyRange.Copy (wshDest.Cells(2, iMasterCol))
Next iColumn
End With


wkbSource.Saved = True
wkbSource.Close
Application.ScreenUpdating = True
Application.Calculation = calcs
End Sub
Click to expand...
 
Back
Top