VBA to transfer data from one workbook to another

Robert_Conklin

Board Regular
Joined
Jun 19, 2017
Messages
173
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
With the help of others, I have created a workbook for our end users that allows them to submit spare part maintenance requests. The problem lies in the fact that we have 48 different locations that will be submitting these requests. Is it possible to create a command button that will only work for specified Windows user names, that when clicked will copy all of the data from the workbook to another workbook on a shared drive? In order to satisfy our internal audit we have to be able to track all of the changes, and having one location to look would take care of that.
 
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
 
Upvote 0

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,954
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top