Previous Topic Next Topic

Transfer from one Excel sheet to another..

Closed
VB rookie - Jul 15, 2011 at 08:46 AM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Jul 19, 2011 at 11:37 AM
Hello,

I have an excel sheet (Sht1) with data in one format -
A2,B2,C3,D2
A3
A4
A5,B5,c5,d5
A6
A7
A8,B8,C8,D8
A9
A10

I need to transfer the data to another sheet in the following format - to be able to sort
A2,B2,C3,D2,E2(Sht1-A3),F2(Sht1-A4)
A3,B3,C3,D3,E3(Sht1-A6),F3(Sht1-A7)
A4,B4,C4,D4,E4(Sht1-A9),F4(Sht1-A10)...etc.

I have started to transfer some of the data using the ='sheetname'!cellref format for each cell, and it works, but have not found a way to populate each cell in the downstream sheet in an efficient manner without typing the format in each cell independently. Is there away to copy this fomat efficeintly to 1000-4000 cells, or can this be a accomplished with VB code? Any help really appreciated. Thanks.



1 response

Answer 1 / 1
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Jul 15, 2011 at 09:14 AM
So if a row has only 1 column used (column A), then that needs to be copied to the the last row above it that had A-d column populated ? Ok it sound confusing. What I am trying to ask is that, row 1 has 4 columns populated, row 2 has only one, then row 3 has only one and row 4 has 4 columns populated
so row1 remains row 1
row2 gets removed and its value get populated in cell E of row 1
row 3 gets removed and its value get populated in cell F of row 1
row 4 remains same
1
VB rookie
Jul 15, 2011 at 12:01 PM
The first part you are are understanding correctly. You would copy & combine the information from rows 2,3,&4 in sheet 1 into row 2 of sheet 2 and then take the next three rows, 5,6,& 7 and copy & combine the information from these rows in sheet 1 into row 3 of sheet 2. (The rows consist of Inventory part data in the 4 cells of the first row, personnel data in the first cell of the 2nd row, and Asset data in the first cell of the 3rd row then repeat over again in the following rows with Part, paeronnel & asset data.) I need to combine these 3 pcs from the first sheet and copy them into the same row of the next sheet for sorting. Thanks
0
VB rookie
Jul 15, 2011 at 12:40 PM
There might be a possibility where multiple parts data rows exist before the personnel & asset exist. I also need to identify the parts data (4 cells) each time in sheet 1 and copy it at the start of a new row in sheet 2 each time followed by personnel & asset data , and not add it onto the end of a row already populated with parts data from the row before from sheet1. (there may be a chance multiple rows of parts data is scanned consecutively into rows in sheet 1 before personnel & asset data are scanned in the following rows.) Thnks
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Jul 15, 2011 at 01:41 PM
Could you post a sample workbook with how the data is and how you would look like on some shared site and post a link back here.
0
VB rookie
Jul 18, 2011 at 08:18 AM
no problem here's the link.
https://docs.google.com/leaf?id=0B0YwZcISo6AWMWY5YWNlYmEtMDZhZC00YWE1LThiNGQtMGQzODExYjQ0ZTJk&sort=name&layout=list&num=50
the "071411 ScanSheet" tab contains an example of the inventory data scanned into the system, and the "071411 SortSheet" tab contains an example of how i want the data transferred over for sorting purposes later on.
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Jul 19, 2011 at 06:31 AM
Try this 
Public Sub doUpdateSortSheet()
   Dim sSrcSheet        As String
   Dim sDesSheet        As String
   Dim lTotalSrcRow     As Long
   Dim lSrcRow          As Long
   Dim lDesRow          As Long
   Dim wsSrc            As Worksheet
   Dim wsDes            As Worksheet
   
   sSrcSheet = "071411 ScanSheet"
   sDesSheet = "071411 SortSheet"
   
   lTotalSrcRow = getItemLocation("*", Sheets(sSrcSheet).Rows)
   If (lTotalSrcRow < 2) Then Exit Sub
   
   Set wsSrc = Worksheets(sSrcSheet)
   Set wsDes = Worksheets(sDesSheet)
   
   lDesRow = getItemLocation("*", wsDes.Rows)
   If lDesRow = 0 Then lDesRow = 1
   lSrcRow = 2
   Do While (lSrcRow <= lTotalSrcRow)
      If (wsSrc.Cells(lSrcRow, "B") <> vbNullString) _
      Then
         If (wsSrc.Cells(lSrcRow + 1, "B") = vbNullString) _
         Then
            lDesRow = lDesRow + 1
            wsSrc.Range(wsSrc.Cells(lSrcRow, "A"), wsSrc.Cells(lSrcRow, "D")).Copy
            wsDes.Cells(lDesRow, "A").PasteSpecial
            wsSrc.Cells(lSrcRow + 1, "A").Copy
            wsDes.Cells(lDesRow, "E").PasteSpecial
            wsSrc.Cells(lSrcRow + 2, "A").Copy
            wsDes.Cells(lDesRow, "F").PasteSpecial
            lSrcRow = lSrcRow + 2
            With wsDes.Range(wsDes.Cells(lDesRow, "A"), wsDes.Cells(lDesRow, "F"))
               .Interior.ColorIndex = xlNone
               .Font.Bold = False
               .FormatConditions.Delete
            End With
         Else
            lSrcRow = lSrcRow
         End If
      Else
         lSrcRow = lSrcRow
      End If
      lSrcRow = lSrcRow + 1
   Loop
   Set wsSrc = Nothing
   Set wsDes = Nothing
End Sub

Public Function getItemLocation(sLookFor As String, _
                                rngSearch As Range, _
                                Optional bFullString As Boolean = True, _
                                Optional bLastOccurance As Boolean = True, _
                                Optional bFindRow As Boolean = True) As Long
                                
   'find the first/last row/column  within a range for a specific string
   
   Dim Cell             As Range
   Dim iLookAt          As Integer
   Dim iSearchDir       As Integer
   Dim iSearchOdr       As Integer
      
   If (bFullString) _
   Then
      iLookAt = xlWhole
   Else
      iLookAt = xlPart
   End If
   If (bLastOccurance) _
   Then
      iSearchDir = xlPrevious
   Else
      iSearchDir = xlNext
   End If
   If Not (bFindRow) _
   Then
      iSearchOdr = xlByColumns
   Else
      iSearchOdr = xlByRows
   End If
      
   With rngSearch
      If (bLastOccurance) _
      Then
         Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
      Else
         Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
      End If
   End With
      
   If Cell Is Nothing Then
      getItemLocation = 0
   ElseIf Not (bFindRow) _
   Then
      getItemLocation = Cell.Column
   Else
      getItemLocation = Cell.Row
   End If
   Set Cell = Nothing

End Function
0