Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Placing data in specific columns
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 -- Carlee |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How retreive specific data from 1st Sheet and placing it on 2nd Sh | Excel Discussion (Misc queries) | |||
Sorting Cells on letters and numbers and placing result in one of 3 columns | Excel Worksheet Functions | |||
import data to specific columns | Excel Discussion (Misc queries) | |||
Copying data to specific columns | Excel Programming | |||
Averaging specific data in columns | Excel Programming |