Page 3 of 3 FirstFirst 123
Results 21 to 24 of 24

Thread: VBA to transfer data from one workbook to another

  1. #21
    Board Regular MrKowz's Avatar
    Join Date
    Jun 2008
    Location
    St. Louis, MO
    Posts
    6,648
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to transfer data from one workbook to another

    Quote Originally Posted by Robert_Conklin View Post
    No problem, thank you for your help.
    Robert,

    I tried to download the files, but it looks like they didn't upload correctly (they're showing as .numbers files). Shooting you a PM with my direct email, so you can send them to me.

    Cheers
    - Posting guidelines, forum rules and terms of use
    - Try searching for your answer first, see how
    - Read the FAQs
    - List of BB codes
    - Please use [CODE] [/CODE] tags when posting your VBA code. It retains spacing, so your code is easier to read, and therefore easier to debug.
    - Please back up your file before using any macros suggested!

  2. #22
    Board Regular
    Join Date
    Jun 2017
    Posts
    105
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to transfer data from one workbook to another

    They have been sent.

  3. #23
    Board Regular MrKowz's Avatar
    Join Date
    Jun 2008
    Location
    St. Louis, MO
    Posts
    6,648
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to transfer data from one workbook to another

    Alrighty, after reviewing your files (and noticing that there was a bit of difference between the column headers of your source file to your destination file), the below code worked for me. I had to split the copy/paste into 3 sections, since in the ADD-EXTEND tab, you had "Modifier" in column AC, but in the "RAW Data" sheet, "Modifier" was column L.

    One thing left to address, is what do you want to do with Columns AD:AI in ADD-EXTEND? There was no placeholder for them in "RAW Data", so I left those columns alone (they are not currently being copied over).

    I also went ahead and added a lot of comments in the code, so you could better understand what is going on. You may find this handy for future VBA applications you develop. Feel free to eliminate any of the comments in your final product.

    Thank you for your patience!

    Code:
    Public Sub CopyData()
    Dim uName       As String
    
    Dim fPath       As String, _
        fName       As String
        
    Dim sWB         As Workbook, _
        sWS         As Worksheet, _
        dWB         As Workbook, _
        dWS         As Worksheet
        
    Dim sLR         As Long, _
        dLR         As Long
        
    uName = Environ("USERNAME")
    
    'Define the file path (fPath) of the workbook needed to open and the file name (fName) of the workbook.
    'These two variables are joined together in the Set dWB line where we open the workbook.
    fPath = "Z:\Engineering\Spar2\WinShuttle Daily Loads\SPAR LOAD PROCESS WORKSHEET 2017"
    fName = "SPAR LOAD PROCESS WORKSHEET 2017.xlsx"
    
    'Turn off ScreenUpdating and change the Calculation mode to Manual.  This is to eliminate screen flickering upon
    'running the macro, as well as to speed up the execution of the code.
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    Select Case uName
        'Expand the names listed next to Case if you want to add more people authorized to hit the Submit button.
        'i.e. "Bill.Howell", "Jane.Doe", "Mr.Excel"
        Case "Bill.Howell"
            'Set Workbook and Worksheet variables
            'Source Workbook (sWB) and Souce Worksheet (sWS)
            Set sWB = ThisWorkbook
            Set sWS = sWB.Sheets("ADD-EXTEND")
            
            'Destination Workbook
            'Destination Workbook (dWB) and Destination Worksheet (dWS)
            Set dWB = Workbooks.Open(fPath & "\" & fName)
            Set dWS = dWB.Sheets("RAW Data")
            
            'Define "Last Row" in Source and Destination Worksheets
            'Note in the dLR variable, we add 1 to the value.  This is to point to the row AFTER the last row.  If we didn't add
            'the + 1, we would be overwriting the last row of data in the Destination Worksheet when we copy over the data.
            sLR = sWS.Range("A" & Rows.Count).End(xlUp).Row
            dLR = dWS.Range("A" & Rows.Count).End(xlUp).Row + 1
            
            'Copy data from Source Worksheet to Destination Worksheet
            With sWS
                .Range(.Cells(2, "A"), .Cells(sLR, "K")).Copy Destination:=dWS.Range("A" & dLR)
                .Range(.Cells(2, "L"), .Cells(sLR, "AB")).Copy Destination:=dWS.Range("M" & dLR)
                .Range(.Cells(2, "AC"), .Cells(sLR, "AC")).Copy Destination:=dWS.Range("L" & dLR)
            End With
        Case Else
            'Do Nothing
    End Select
    
    'Turn ScreenUpdating and Automatic Calculations back on.
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
    End Sub
    - Posting guidelines, forum rules and terms of use
    - Try searching for your answer first, see how
    - Read the FAQs
    - List of BB codes
    - Please use [CODE] [/CODE] tags when posting your VBA code. It retains spacing, so your code is easier to read, and therefore easier to debug.
    - Please back up your file before using any macros suggested!

  4. #24
    Board Regular
    Join Date
    Jun 2017
    Posts
    105
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to transfer data from one workbook to another

    After many revisions, and finding out exactly what I was needing. MrKowz, you are a genius!! Thank you very much for your knowledge and patience with me as I tried my best to explain what it was I needed. You were able to sift through the garbage and help complete my project! Everyone here at work is VERY please with the final product!

    Here is the final code for anyone that can use it:

    MODULE 1 -
    Code:
    Option Explicit
    
    Public Sub CopyData()
    ' I recommend getting in the habit of explicitly declaring every variable you use in your code.
    ' It will make your life easier and your code faster. :)
    ' BAL = BASIC worksheet
    ' EXT = EXTEND worksheet
    ' VAL = 4X4 EXTEND worksheet
    ' MML = MIN-MAX (LOAD) worksheet
    ' BLL = BIN-LOC (LOAD) worksheet
    ' NDL = ND (LOAD) worksheet
    ' IOL = INA-OBS (LOAD) worksheet
    ' AUL = ALT-UoM (LOAD) worksheet
    ' MTL = MANUAL TRANSFER (MIGO)(LOAD) worksheet
    
    
    ' Variable DIMs for workbook and worksheet variables moved to public variables,
    ' so they are easily accessible to subroutines.
    ' This is not best practice, but I opted to go this route, because I can see you
    ' making enhancements to this which could involve more custom subroutines like the
    ' one in mBASIC_4x4, and I think this might make it a bit easier in the long run.
    '
    ' Best practice would be to limit the variables passed into subroutines by use of arguments.
    Dim uName       As String
    
    
    Dim fpath       As String, _
        fname       As String
           
    Dim sWB         As Workbook, _
        dWB         As Workbook
           
    Dim sAE         As Worksheet, _
        sDC         As Worksheet, _
        sMM         As Worksheet, _
        sBL         As Worksheet, _
        sND         As Worksheet, _
        sIO         As Worksheet, _
        sAU         As Worksheet, _
        sMT         As Worksheet
            
    Dim dAE         As Worksheet, _
        dDC         As Worksheet, _
        dMM         As Worksheet, _
        dBL         As Worksheet, _
        dND         As Worksheet, _
        dIO         As Worksheet, _
        dAU         As Worksheet, _
        dMT         As Worksheet, _
        dMML        As Worksheet, _
        dBLL        As Worksheet, _
        dAUL        As Worksheet, _
        dMTL        As Worksheet, _
        dBAL        As Worksheet, _
        dEXT        As Worksheet, _
        dVAL        As Worksheet
        
    Dim sLR         As Long, _
        dLR         As Long
        
    uName = Environ("USERNAME")
    
    
    'Define the file path (fPath) of the workbook needed to open and the file name (fName) of the workbook.
    'These two variables are joined together in the Set dWB line where we open the workbook.
    fpath = "C:\Users\Robert.Conklin\Desktop"
    fname = "SPAR LOAD PROCESS WORKSHEET 2017 2.xlsx"
    
    
    'Turn off ScreenUpdating and change the Calculation mode to Manual.  This is to eliminate screen flickering upon
    'running the macro, as well as to speed up the execution of the code.
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    
    Select Case uName
        'Expand the names listed next to Case if you want to add more people authorized to hit the Submit button.
        'i.e. "Bill.Howell", "Jane.Doe", "Mr.Excel"
        Case "Bill.Howell", "Robert.Conklin", "Tracy.Corbitt"
            'Set Workbook and Worksheet variables
            'Source Workbook (sWB) and Souce Worksheet (sWS)
            Set sWB = ThisWorkbook
            
            Set sAE = sWB.Sheets("ADD-EXTEND")
            Set sDC = sWB.Sheets("DESCRIPTION CHANGES")
            Set sMM = sWB.Sheets("MIN-MAX")
            Set sBL = sWB.Sheets("BIN-LOC")
            Set sND = sWB.Sheets("ND")
            Set sIO = sWB.Sheets("INA-OBS")
            Set sAU = sWB.Sheets("ALT-UoM")
            Set sMT = sWB.Sheets("MANUAL TRANSFER (MIGO)")
                    
            'Destination Workbook
            'Destination Workbook (dWB) and Destination Worksheet (dWS)
            Set dWB = Workbooks.Open(fpath & "\" & fname)
            
            Set dAE = dWB.Sheets("RAW Data")
            Set dDC = dWB.Sheets("DESCRIPTION CHANGES")
            Set dMM = dWB.Sheets("MIN-MAX")
            Set dBL = dWB.Sheets("BIN-LOC")
            Set dND = dWB.Sheets("ND")
            Set dIO = dWB.Sheets("INA-OBS")
            Set dAU = dWB.Sheets("ALT-UoM")
            Set dMT = dWB.Sheets("MANUAL TRANSFER (MIGO)")
            Set dMML = dWB.Sheets("MIN-MAX (LOAD)")
            Set dBLL = dWB.Sheets("BIN-LOC (LOAD)")
            Set dAUL = dWB.Sheets("ALT-UoM (LOAD)")
            Set dMTL = dWB.Sheets("MANUAL TRANSFER (MIGO)(LOAD)")
            Set dBAL = dWB.Sheets("BASIC")
            Set dEXT = dWB.Sheets("EXTEND")
            Set dVAL = dWB.Sheets("4X4 EXTEND")
            
            'Copy data from Source Worksheet to Destination Worksheet
            With sAE
                'Define "Last Row" in Source and Destination Worksheets
                'Note in the dLR variable, we add 1 to the value.  This is to point to the row AFTER the last row.  If we didn't add
                'the + 1, we would be overwriting the last row of data in the Destination Worksheet when we copy over the data.
                '
                'Also note we must redefine these variables each time we want to copy from a different worksheet.  One worksheet's last row
                'is different from another worksheet's last row
                sLR = .Range("A" & Rows.Count).End(xlUp).Row
                dLR = dAE.Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range(.Cells(2, "A"), .Cells(sLR, "AC")).Copy Destination:=dAE.Range("A" & dLR)
                .Range(.Cells(2, "E"), .Cells(sLR, "E")).Copy Destination:=dEXT.Range("A" & dLR)
                .Range(.Cells(2, "C"), .Cells(sLR, "C")).Copy Destination:=dEXT.Range("B" & dLR)
                .Range(.Cells(2, "G"), .Cells(sLR, "G")).Copy Destination:=dEXT.Range("C" & dLR)
                .Range(.Cells(2, "J"), .Cells(sLR, "J")).Copy Destination:=dEXT.Range("D" & dLR)
                .Range(.Cells(2, "T"), .Cells(sLR, "T")).Copy Destination:=dEXT.Range("E" & dLR)
                .Range(.Cells(2, "K"), .Cells(sLR, "K")).Copy Destination:=dEXT.Range("F" & dLR)
                .Range(.Cells(2, "U"), .Cells(sLR, "U")).Copy Destination:=dEXT.Range("G" & dLR)
                .Range(.Cells(2, "V"), .Cells(sLR, "V")).Copy Destination:=dEXT.Range("H" & dLR)
                .Range(.Cells(2, "H"), .Cells(sLR, "H")).Copy Destination:=dEXT.Range("I" & dLR)
            End With
            With sDC
                sLR = .Range("A" & Rows.Count).End(xlUp).Row
                dLR = dDC.Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range(.Cells(2, "A"), .Cells(sLR, "J")).Copy Destination:=dDC.Range("A" & dLR)
            End With
            With sMM
                sLR = .Range("A" & Rows.Count).End(xlUp).Row
                dLR = dMM.Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range(.Cells(2, "A"), .Cells(sLR, "O")).Copy Destination:=dMM.Range("A" & dLR)
                .Range(.Cells(2, "D"), .Cells(sLR, "D")).Copy Destination:=dMML.Range("A" & dLR)
                .Range(.Cells(2, "C"), .Cells(sLR, "C")).Copy Destination:=dMML.Range("B" & dLR)
                .Range(.Cells(2, "J"), .Cells(sLR, "J")).Copy Destination:=dMML.Range("C" & dLR)
                .Range(.Cells(2, "H"), .Cells(sLR, "H")).Copy Destination:=dMML.Range("D" & dLR)
                .Range(.Cells(2, "I"), .Cells(sLR, "I")).Copy Destination:=dMML.Range("E" & dLR)
            End With
            With sBL
                sLR = .Range("A" & Rows.Count).End(xlUp).Row
                dLR = dBL.Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range(.Cells(2, "A"), .Cells(sLR, "J")).Copy Destination:=dBL.Range("A" & dLR)
                .Range(.Cells(2, "D"), .Cells(sLR, "D")).Copy Destination:=dBLL.Range("A" & dLR)
                .Range(.Cells(2, "C"), .Cells(sLR, "C")).Copy Destination:=dBLL.Range("B" & dLR)
                .Range(.Cells(2, "G"), .Cells(sLR, "G")).Copy Destination:=dBLL.Range("C" & dLR)
            End With
            With sND
                sLR = .Range("A" & Rows.Count).End(xlUp).Row
                dLR = dND.Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range(.Cells(2, "A"), .Cells(sLR, "K")).Copy Destination:=dND.Range("A" & dLR)
            End With
            With sIO
                sLR = .Range("A" & Rows.Count).End(xlUp).Row
                dLR = dIO.Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range(.Cells(2, "A"), .Cells(sLR, "L")).Copy Destination:=dIO.Range("A" & dLR)
            End With
            With sAU
                sLR = .Range("A" & Rows.Count).End(xlUp).Row
                dLR = dAU.Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range(.Cells(2, "A"), .Cells(sLR, "O")).Copy Destination:=dAU.Range("A" & dLR)
                .Range(.Cells(2, "D"), .Cells(sLR, "D")).Copy Destination:=dAUL.Range("A" & dLR)
                .Range(.Cells(2, "F"), .Cells(sLR, "F")).Copy Destination:=dAUL.Range("B" & dLR)
                .Range(.Cells(2, "G"), .Cells(sLR, "G")).Copy Destination:=dAUL.Range("C" & dLR)
                .Range(.Cells(2, "I"), .Cells(sLR, "I")).Copy Destination:=dAUL.Range("D" & dLR)
            End With
            With sMT
                sLR = .Range("A" & Rows.Count).End(xlUp).Row
                dLR = dMT.Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range(.Cells(3, "A"), .Cells(sLR, "O")).Copy Destination:=dMT.Range("A" & dLR)
                .Range(.Cells(3, "B"), .Cells(sLR, "B")).Copy Destination:=dMTL.Range("A" & dLR)
                .Range(.Cells(3, "D"), .Cells(sLR, "D")).Copy Destination:=dMTL.Range("B" & dLR)
                .Range(.Cells(3, "E"), .Cells(sLR, "E")).Copy Destination:=dMTL.Range("C" & dLR)
                .Range(.Cells(3, "F"), .Cells(sLR, "F")).Copy Destination:=dMTL.Range("D" & dLR)
                .Range(.Cells(3, "G"), .Cells(sLR, "G")).Copy Destination:=dMTL.Range("E" & dLR)
                .Range(.Cells(3, "H"), .Cells(sLR, "H")).Copy Destination:=dMTL.Range("F" & dLR)
                .Range(.Cells(3, "I"), .Cells(sLR, "I")).Copy Destination:=dMTL.Range("G" & dLR)
                .Range(.Cells(3, "J"), .Cells(sLR, "J")).Copy Destination:=dMTL.Range("H" & dLR)
            End With
            
            'Call Compile_Basic_4x4 macro and pass sWB, sWS, dWB , dBAL, dVAL variables to it
            Compile_Basic_4x4 sWB, sAE, dWB, dBAL, dVAL
            
        Case Else
            'Do Nothing
    End Select
    
    
    'Turn ScreenUpdating and Automatic Calculations back on.
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
    
    End Sub
    MODULE 2 -

    Code:
    Option ExplicitPublic Sub Compile_Basic_4x4(sWB As Workbook, sWS As Worksheet, dWB As Workbook, dBASIC As Worksheet, d4x4 As Worksheet)
            
    Dim rng             As Range, _
        sLR             As Long
        
    Dim tSAPNum         As String, _
        tSAPDesc        As String, _
        tUOM            As String, _
        tMatGrp         As String, _
        tPlant          As String
        
    Dim LRBasic         As Long, _
        LR4x4           As Long
        
    Dim ARR4x4          As Variant
    
    
    ARR4x4 = Array("PM-NEW", "PM-USED", "PM-REBUILT")
    
    
    sLR = sWS.Range("D" & Rows.Count).End(xlUp).Row
    
    
    For Each rng In sWS.Range("D2:D" & sLR)
        tSAPNum = sWS.Range("E" & rng.Row).Value
        tSAPDesc = sWS.Range("R" & rng.Row).Value
        tUOM = sWS.Range("I" & rng.Row).Value
        tMatGrp = sWS.Range("W" & rng.Row).Value
        tPlant = sWS.Range("C" & rng.Row).Value
        Select Case UCase(rng.Value)
            Case "ADD"
                With dBASIC
                    LRBasic = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    With .Range("A" & LRBasic)
                        .Value = tSAPNum
                        .Offset(0, 1).Value = tSAPDesc
                        .Offset(0, 2).Value = tUOM
                        .Offset(0, 3).Value = tMatGrp
                    End With
                End With
                With d4x4
                    LR4x4 = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    With .Range("A" & LR4x4)
                        .Resize(3, 1).Value = tSAPNum
                        .Offset(0, 1).Resize(3, 1).Value = tPlant
                        .Offset(0, 2).Resize(3, 1).Value = Application.Transpose(ARR4x4)
                    End With
                End With
            Case "EXTEND"
                With d4x4
                    LR4x4 = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    With .Range("A" & LR4x4)
                        .Resize(3, 1).Value = tSAPNum
                        .Offset(0, 1).Resize(3, 1).Value = tPlant
                        .Offset(0, 2).Resize(3, 1).Value = Application.Transpose(ARR4x4)
                    End With
                End With
            Case Else
                'Do Nothing
        End Select
    Next rng
    
    
    End Sub

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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