简体   繁体   中英

How to Copy Column From User-Chosen Source Workbook\Worksheet\Column to Active Target Workbook\Worksheet\Column?

Source column contains a string in each cell. There are 4000+ cells. These need to be copied and pasted into a worksheet of the active (one that invoked the macro) workbook. Source workbook should be selected by the user using a search/browse pop-up box.

Code below does something close to my intended goal but...the directory as you see is static which is unacceptable. Maximum flexibility should be had with user choosing the source file manually. Furthermore, I want to prevent the file path from becoming obsolete every time folders/files get renamed/shifted. Something tell me " Application.GetOpenFilename() " should be used. But how to correctly implement it?

Having little experience with the VBA, my attempts to mod this macro failed. So I am asking for your help/advice on the matter. Again, code below works well but its not flexible enough to be practical. Thanks guys! :)

EDIT: Problem solved! See final, working code. Hope it's of some use to programmers out there. :)

'MACRO TO READ-IN EXTERNAL EXCEL FILE FROM WHICH JOB NO.'S ARE EXTRACTED INTO USERFORM Sub ReadDataFromCloseFile()

        'IN CASE OF ERROR SEND TO ERROR FUNCTION
            On Error GoTo ErrHandler

        'PREVENT OPENED EXCEL SOURCE FILE FROM SHOWING TO USER
            Application.ScreenUpdating = False

        'OPEN SOURCE EXCEL WORKBOOK IN "READ ONLY MODE"
            Dim SrcName As String
            Dim src As Workbook
            SrcName = Application.GetOpenFilename()
            Set src = Workbooks.Open(SrcName, True, True)

        'GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK
            Dim iTotalRows As Integer
            iTotalRows = src.Worksheets("PROJECT LIST").Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count

        'COPY DATA FROM SOURCE WORKBOOK  -> DESTINATION WORKBOOK
            Dim iCnt As Integer     '(COUNTER)
            For iCnt = 1 To iTotalRows
                Worksheets("Test_File_8").Range("B" & (iCnt + 1)).Formula = src.Worksheets("PROJECT LIST").Range("A" & (iCnt + 1)).Formula
            Next iCnt

        'CLOSE THE SOURCE WORKBOOK FILE
            src.Close False             'FALSE = DONT SAVE THE SOURCE FILE
            Set src = Nothing           'FLUSH DATA

        'ERROR FUNCTION

ErrHandler: Application.EnableEvents = True Application.ScreenUpdating = True End Sub

See my changes below. I added two variables X and strSrc . X is a variant that is used to loop through .SelectedItems and strSrc is that string that ultimately holds the path.

    Sub ReadDataFromCloseFile()

    'Set variable to hold workbook path and workbook path string
       Dim X as Variant
       Dim strSrc as String

       With Application.FileDialog(msoFileDialogFilePicker)
          .InitialFileName = "" ' You can provide a base path here
          .Title = "Select file."
          .AllowMultiSelect = False
          If .Show = -1 Then
              For Each X In .SelectedItems
                  strSrc = X
                  Exit For
              Next X
          End If
       End With

    'IN CASE OF ERROR SEND TO ERROR FUNCTION
        'On Error GoTo ErrHandler

    'PREVENT OPENED EXCEL SOURCE FILE FROM SHOWING TO USER
        Application.ScreenUpdating = False

    'OPEN SOURCE EXCEL WORKBOOK IN "READ ONLY MODE"
        Dim src As Workbook
        Set src = Workbooks.Open(strSrc, True, True)

    'GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK
        Dim iTotalRows As Integer
        iTotalRows = src.Worksheets("PROJECT LIST").Range("A1:A" & src.Worksheets("PROJECT LIST").Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count

    'COPY DATA FROM SOURCE WORKBOOK  -> DESTINATION WORKBOOK
            Dim iCnt As Integer     '(COUNTER)
            For iCnt = 1 To iTotalRows
                src.Worksheets("Test_File_8").Range("B" & (iCnt + 1)).Formula = src.Worksheets("PROJECT LIST").Range("A" & (iCnt + 1)).Formula
            Next iCnt

    'CLOSE THE SOURCE WORKBOOK FILE
        src.Close False             'FALSE = DONT SAVE THE SOURCE FILE
        Set src = Nothing           'FLUSH DATA

    'ERROR FUNCTION
     ErrHandler: Application.EnableEvents = True Application.ScreenUpdating = True End Sub

    'MACRO TO READ-IN EXTERNAL EXCEL FILE FROM WHICH JOB NO.'S ARE EXTRACTED INTO USERFORM

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM