VBA Copy COLs "B", "E" and "N" into the other open Excel file - into "AB", "AC" and "AD"

C

ChrisOK

Well-known Member
Joined
Mar 26, 2003
Messages
601
Tying code to a quick toolbar button to expedite a repetitive task of always copying the same columns from an export file into my main parts data file as follows:

Starting w/ ROW 3 in filename: "exportParts.xls" (it will ALWAYS be this file name)
Select B3 down until end of data and PASTE into the other open Excel file and PASTE starting at AB5 down
Select E3 down until end of data and PASTE into the other open Excel file and PASTE starting at AC5 down
Select N3 down until end of data and PASTE into the other open Excel file and PASTE starting at AD5 down

The other file (that it will paste in to) will have various names so I will make sure that ONLY those 2 Excel files are open to keep the code from pasting into an unwanted other file. (keeping in mind to exclude the Personal file which is always open) thus pasting into the 3rd Excel file available/open.

Help greatly appreciated!
 
Sort by date Sort by votes
I have created a setup which I believe to match your specification and it works for me, so I am obviously missing something, but cannot figure out what it is...

I have two workbook "exportParts.xls" which has three sheets, "Sheet1", "Sheet2" and "Sheet3" with data on "Sheet1" in column B, E and & N all starting in row 3, each column has at least three things (mostly random gibberish). This workbook has a Module called Module1 which contains the provided code wrapped in a sub called Transfer.

Then I have a source book called "Book2" which has three sheets, "Sheet1", "SSParts Worksheet" and "Sheet3".

When I run the code it transfers what I have in "exportParts.xls" column B, E and N to "Book2"'s sheet "SSParts Worksheet" into column AB, AC and AD (all starting in Row 5) respecfully.

If you can see any fundemental difference in our setup, let me know and we can adjust the code accordingly.

Sorry, I am really not seeing why it works for me but not you.
 
Upvote 0

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
I've tested it several times on the 2 files and I see what's happening but I don't know how to fix it...
Basically, the code is taking the column data from B, E, N and pasting it WITHIN THAT SAME FILE into columns AB, AC, AD.

Need to insert something in the code to make it look to the 2nd (RECIPIENT) file and paste there -- rather than within itself..
I see where it copies data while in the source file:

I'm not seeing where it tells it to paste SPECIFICALLY into ""SSParts Worksheet" of the oposing file...
Code: 
' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("B" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column B to AB of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("B3:B" & lngLastRow).Copy
        oWS.Range("AB5").PasteSpecial
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("E" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column E to AC of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("E3:E" & lngLastRow).Copy
        oWS.Range("AC5").PasteSpecial
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("N" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column B to AB of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("N3:N" & lngLastRow).Copy
        oWS.Range("AD5").PasteSpecial
    End With

I'm no expert for sure -- but it seems like it should have a line that tells it to pastspecial to "SSParts Worksheet" Sheet2

Couple of side notes that could be causing a problem: ?
1. My module is not within either of the 2 files (like yours is), it is created within the PERSONAL workbook.
2. You stated this in your code:
' -----------------------------------------------------------------------------------------
' SPECIAL NOTE: For our purposes we are assuming that the data is going from and to
' Sheets(1) of each WB
' -----------------------------------------------------------------------------------------
However, this is not a true statement.
* Within the EXPORTING Source file called "ExportParts.xls", it only has one sheet called: "Supportability" which is indeed 'Sheet1'
* But within the RECIPIENT file (that has no specific workbook name), it has several sheets and the one it should paste to is 'Sheet2' called "SS Parts Worksheet"

hope that might help...?
 
Upvote 0
1) The location of the code does not matter. It is cycling through all open workbooks to find both workbook "exportParts.xls" and worksheet "SSParts Worksheet"
2) the comments in the code are from the original code when I didn't know about "SSParts Worksheet", the code was changed but I just never bothered to change the comments.

As for the part in the code which finds "SSParts Worksheet"
Code: 
    ' -----------------------------------------------------------------------------------------
    ' Find workbook with Worksheet named SSParts Worksheet
    ' -----------------------------------------------------------------------------------------
    For Each oWB In Workbooks                      ' cycling through each open workbook
        For Each oWS In oWB.Sheets                 ' cycling through each sheet of each workbook
            If oWS.Name = "SSParts Worksheet" Then ' comparing the sheet name to find the one we are looking for
                Set objInputWB = oWB
                bFound = True
            End If
            If bFound Then Exit For
        Next oWS
        If bFound Then Exit For
    Next oWB
    Set oWB = Nothing

At this point oWS is the worksheet with the name "SSParts Worksheet" while the line Set objInputWB = oWB is a bit superfluous.

So again, still not sure what the difference is in our environments which is causing it not to work for you.
 
Upvote 0
ROSEN! Got it working! :beerchug: It was an issue with a sheet name (a character was off in master file when renamed)! Works like a charm!
Had someone request today - that the entire tab be copied IN addition to what is already copying over. (see end of code)
Is there an easy way to add a couple lines at the end (that will utilize the dims already defined with the previous code that will remain in tact)?

Code: 
 ' -----------------------------------------------------------------------------------------
    ' Define variables
    ' -----------------------------------------------------------------------------------------
    Dim strFilename As String
    Dim strWorkbookName As String
    Dim objInputWB As Workbook
    Dim objExtractWB As Workbook
    Dim oWB As Workbook, oWS As Worksheet
    Dim lngLastRow As Long, bFound As Boolean
    ' -----------------------------------------------------------------------------------------
    ' Find workbook with Worksheet named SSParts Worksheet
    ' -----------------------------------------------------------------------------------------
    For Each oWB In Workbooks
        For Each oWS In oWB.Sheets
            If oWS.Name = "SSParts Worksheet" Then
                Set objInputWB = oWB
                bFound = True
            End If
            If bFound Then Exit For
        Next oWS
        If bFound Then Exit For
    Next oWB
    Set oWB = Nothing
    ' -----------------------------------------------------------------------------------------
    ' Advise user and terminate program if we cannot find the approprate workbook.
    ' -----------------------------------------------------------------------------------------
    If Not bFound Then
        MsgBox Prompt:="Unable to find data's destination, terminating transfer!", _
               Buttons:=vbCrtical, _
               Title:="Export"
        Exit Sub
    End If
    ' -----------------------------------------------------------------------------------------
    ' Determine if our extract workbook (exportParts.xls) is open
    ' -----------------------------------------------------------------------------------------
    For Each oWB In Workbooks
        If oWB.Name = "exportParts.xls" Then
            Set objExtractWB = oWB
            Exit For
        End If
    Next oWB
    Set oWB = Nothing
    ' -----------------------------------------------------------------------------------------
    ' If we don't find our extract workbook open
    ' -----------------------------------------------------------------------------------------
    If objExtractWB Is Nothing Then
        MsgBox Prompt:="Invalid selection detected, cancelling data Extraction!", _
               Buttons:=vbCritical, _
               Title:="Export"
        Exit Sub
    End If
    ' -----------------------------------------------------------------------------------------
    ' SPECIAL NOTE: For our purposes we are assuming that the data is going from and to
    ' Sheets(1) of each WB
    ' -----------------------------------------------------------------------------------------
    If Not oWS.Name = "SSParts Worksheet" Then
        For Each oWS In oInputWB.Sheets
            If oWS.Name = "SSParts Worksheet" Then
                Exit For
            End If
        Next oWS
    End If
    With objExtractWB.Sheets(1)
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("B" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column B to AB of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("B3:B" & lngLastRow).Copy
        oWS.Range("AB5").PasteSpecial
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("E" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column E to AC of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("E3:E" & lngLastRow).Copy
        oWS.Range("AC5").PasteSpecial
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("N" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column B to AB of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("N3:N" & lngLastRow).Copy
        oWS.Range("AD5").PasteSpecial
    End With
'
'INSERT A COMMAND HERE/AT THE END THAT WILL COPY THE WHOLE SHEET/TAB FROM THE "EXPORT FILE
'TO THE END OF EXISTING SHEETS OF THE "bom WORKSHEET FILE"
'CODE SHOULD:
'In "ExportParts.xls" FILE, sheet1 called: "Supportability", COPY THAT SHEET TO THE OTHER FILE THAT WILL HAVE VARIOUS FILE NAMES
'>>>>>>>>>>>>>
'>>>>>>>>>
>>>>>>>>
    MsgBox "Transfer Complete!"
 
Upvote 0
Try something like (before the "End With" line):
Code: 
.Copy After:=objInputWB.Sheets(objInputWB.Sheets.Count)
I haven't tested it, so backup your work before running!

Hope that helps!
 
Upvote 0
TOTALLY AWESOME!! :beerchug:
Inserts beautifully, but one thing :confused: --- it takes the user/analyst to that new tab it has copied into the file... How do I make it return focus back to the "BOM Worksheet" (A1) as the last step - rather than leaving them on the newly inserted sheet?
 
Upvote 0
Try:
Code: 
    ' -----------------------------------------------------------------------------------------
    ' Define variables
    ' -----------------------------------------------------------------------------------------
    Dim strFilename As String
    Dim strWorkbookName As String
    Dim objInputWB As Workbook
    Dim objExtractWB As Workbook
    Dim oWB As Workbook, oWS As Worksheet
    Dim lngLastRow As Long, bFound As Boolean
    ' -----------------------------------------------------------------------------------------
    ' Find workbook with Worksheet named SSParts Worksheet
    ' -----------------------------------------------------------------------------------------
    For Each oWB In Workbooks
        For Each oWS In oWB.Sheets
            If oWS.Name = "SSParts Worksheet" Then
                Set objInputWB = oWB
                bFound = True
            End If
            If bFound Then Exit For
        Next oWS
        If bFound Then Exit For
    Next oWB
    Set oWB = Nothing
    ' -----------------------------------------------------------------------------------------
    ' Advise user and terminate program if we cannot find the approprate workbook.
    ' -----------------------------------------------------------------------------------------
    If Not bFound Then
        MsgBox Prompt:="Unable to find data's destination, terminating transfer!", _
               Buttons:=vbCrtical, _
               Title:="Export"
        Exit Sub
    End If
    ' -----------------------------------------------------------------------------------------
    ' Determine if our extract workbook (exportParts.xls) is open
    ' -----------------------------------------------------------------------------------------
    For Each oWB In Workbooks
        If oWB.Name = "exportParts.xls" Then
            Set objExtractWB = oWB
            Exit For
        End If
    Next oWB
    Set oWB = Nothing
    ' -----------------------------------------------------------------------------------------
    ' If we don't find our extract workbook open
    ' -----------------------------------------------------------------------------------------
    If objExtractWB Is Nothing Then
        MsgBox Prompt:="Invalid selection detected, cancelling data Extraction!", _
               Buttons:=vbCritical, _
               Title:="Export"
        Exit Sub
    End If
    ' -----------------------------------------------------------------------------------------
    ' SPECIAL NOTE: For our purposes we are assuming that the data is going from and to
    ' Sheets(1) of each WB
    ' -----------------------------------------------------------------------------------------
    If Not oWS.Name = "SSParts Worksheet" Then
        For Each oWS In oInputWB.Sheets
            If oWS.Name = "SSParts Worksheet" Then
                Exit For
            End If
        Next oWS
    End If
    With objExtractWB.Sheets(1)
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("B" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column B to AB of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("B3:B" & lngLastRow).Copy
        oWS.Range("AB5").PasteSpecial
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("E" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column E to AC of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("E3:E" & lngLastRow).Copy
        oWS.Range("AC5").PasteSpecial
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("N" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column B to AB of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("N3:N" & lngLastRow).Copy
        oWS.Range("AD5").PasteSpecial
        
        .Copy After:=objInputWB.Sheets(objInputWB.Sheets.Count)
    End With
    objInputWB.Sheets("BOM Worksheet").Activate
    ActiveSheet.Range("A1").Select
    MsgBox "Transfer Complete!"
Hope that helps!
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
710
Micron
M
F
  • Solved
Copy paste from one Excel workbook to another with same sheet names and update dates in range
Replies
8
Views
476
Skiier89
S
P
  • Question Question
Locate certain file in the download folder and then copy and paste content to another worksheet in another workbook
Replies
1
Views
215
Micron
M
B
  • Question Question
VBA exports worksheet from XLSM to XLXS matching all source properties doesn't keep print area
Replies
0
Views
80
brentcole
B
P
  • Solved
VBA to open file using Cell for the path
Replies
4
Views
1K
Peter Davison
P

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

Share this page

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