Consulting

Results 1 to 3 of 3

Thread: Transferring data workbook to workbook

  1. #1
    VBAX Regular
    Joined
    Feb 2015
    Posts
    79
    Location

    Transferring data workbook to workbook

    Good afternoon,


    I have two workbooks I am trying to transfer data between


    workbook1 is the source file


    workbook2 is the destination file


    The source file that I receive usually comes to me with more columns of data than I need, and columns are never in the same order.


    All of the columns in the source and destination files have a title


    What I would like to be able to do is search for the desired header, copy the data for the latest date (11/25/22), then paste it into workbook2 in the appropriate spot


    Attached are examples of workbook1 and workbook2. Sample numbers are inserted to show where data starts and where I would like it to go.

    Please let me know if I need to better explain anything.

    Any help you can give is greatly appreciated.

    Chunk
    Attached Files Attached Files

  2. #2
    VBAX Regular
    Joined
    Feb 2015
    Posts
    79
    Location
    The "latest" date is always going to be a Friday date

  3. #3
    VBAX Regular
    Joined
    May 2018
    Location
    Sydney
    Posts
    57
    Location
    Sub copyData()
    
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim r1 As Range, r2 As Range
    Dim lRow As Long
    Dim title As String
    
    
    Set wb1 = Workbooks("workbook1.xlsx") 'source workbook
    Set ws1 = wb1.Sheets("Sheet1")
    
    
    Set wb2 = Workbooks("workbook2.xlsx") 'destination workbook
    Set ws2 = wb2.Sheets("Sheet1")
    
    
    row = 2
    Do While ws1.Range("A" & row).Value <> ""
        col = 2
        Do While ws1.Range(Cells(1, col).Address).Value <> ""
            Set rng1 = ws1.Range("A" & row)
            Set rng2 = ws1.Range(Cells(1, col).Address)
            Set rng3 = ws2.Range("A:A").Find(rng2.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not rng3 Is Nothing Then
                Set rng4 = ws2.Range("1:1").Find(rng1.Value, LookIn:=xlValues, LookAt:=xlWhole)
                If Not rng4 Is Nothing Then
                    ws2.Cells(rng3.row, rng4.Column).Value = ws1.Cells(rng1.row, rng2.Column).Value
                End If
            End If
            col = col + 1
        Loop
        row = row + 1
    Loop
    
    
    End Sub
    If you only ever do what you can , you'll only ever be what you are.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •