Placing data in specific columns

[Carlee]

Hello All,

The code listed below (thank you JLatham) works to transfer the last row of
data in Workbook1 (Copreco Reading) to workbook2 (Master Log). This works
great, however, I need to be able to specifically place each piece of data
from Workbook 1 to a specific column in Workbook2. I will have to do this
for approximately 90 columns.

Can anyone shed some light on this for me?


Option Explicit

' Access the GetUserNameA function in advapi32.dll and
' call the function GetUserName.
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

Sub CopyFromCoprecoReading()
'these have to do with THIS workbook
'name of the sheet to get data from
Const destSheet = "MasterSheet" ' in HQ master workbook
'column that always have value in it in last row
Const destKeyColumn = "A"
'****
'This is the name you want to give to the
'NEW workbook created each time to put new data
'into as set up this code will overwrite any
'existing file of this name without any warning.
Const newWorkbookName = "Copreco Reading.xls"
Const sourceSheet = "Sheet1"
'****

Dim sourceBook As String
Dim destBook As String
Dim sourceRange As Range
Dim destRange As Range
Dim MaxLastRow As Long
Dim destLastRow As Long
Dim pathToUserDesktop As String
Dim filePath As Variant

'determine last possible row number
'based on version of Excel in use
If Val(Left(Application.Version, 2)) < 12 Then
'we are in pre-Excel 2007 version
MaxLastRow = Rows.Count
Else
'are in Excel 2007 (or later?)
MaxLastRow = Rows.CountLarge
End If
'keeps screen from flickering
'speeds things up also
Application.ScreenUpdating = False
destBook = ThisWorkbook.Name
'build up the path to the user's desktop
'based on standard paths and Windows standards
'path is normally
' C:\Documents and Settings\username\Desktop
'our task is to determine the 'username' portion
'which is the Windows username (login name) which
'may be different than the Excel UserName
pathToUserDesktop = "C:\Documents and Settings\" & _
Get_Win_User_Name() & "\Desktop\" & newWorkbookName
'
'see if that workbook is where it is supposed to be
'
sourceBook = Dir$(pathToUserDesktop)
If sourceBook = "" Then
'it's not on the desktop
'have the user browse for it
filePath = Application.GetSaveAsFilename
If filePath = False Then
Exit Sub ' user cancelled
End If
pathToUserDesktop = filePath
End If
' open the 'Copreco Reading.xls' file
Workbooks.Open pathToUserDesktop
sourceBook = ActiveWorkbook.Name
Windows(sourceBook).Activate
Worksheets(sourceSheet).Select
'new data is always on 'Sheet1' in row 2
Set sourceRange =
Workbooks(sourceBook).Worksheets(sourceSheet).Rows("2:2")
'get back over to this workbook
Windows(destBook).Activate
'to sheet to add data to
Worksheets(destSheet).Activate
'find out what row is available
destLastRow = Range("A" & MaxLastRow).End(xlUp).Row + 1
If destLastRow > MaxLastRow Then
MsgBox "No room in HQ Master Sheet to add entry. Aborting
operation.", _
vbOKOnly + vbCritical, "No Room on Sheet"
Exit Sub
End If

Set destRange = Workbooks(destBook).Worksheets( _
destSheet).Rows(destLastRow & ":" & destLastRow)
'copy the data
destRange.Value = sourceRange.Value
Set destRange = Nothing
Set sourceRange = Nothing
Application.DisplayAlerts = False
'close the 'Copreco Reading.xls' file
'w/o saving any changes
Workbooks(sourceBook).Close False
Application.DisplayAlerts = True
'done
Application.ScreenUpdating = True
End Sub

Private Function Get_Win_User_Name() As String

' Dimension variables
Dim lpBuff As String * 25
Dim ret As Long, UserName As String

' Get the user name minus any trailing spaces found in the name.
ret = GetUserName(lpBuff, 25)
Get_Win_User_Name = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
End Function