Write a simple macro to seek input for copy and paste

[zacuk]

Hi,

Could you help me with writing a simple macro which does the following, please:

1. Ask for the file location / path
2. Get (copy) the values in cells C2 to C200 in the tab XYZ of the specified file
3. Paste the values transposed, i.e., in a row
4. NOTE: I would like the link to each cell to be copied, not just the value. So that if the data is updated in the original file, it gets updated here too.

Thanks

 

[bsquad]

(since you didn't specify count of or specific worksheets and you mentioned 'simple') - I defaulted:
-the copy worksheet, meaning its the first and only worksheet to copy on the import workbook
-the Master / End workbook's worksheet to the first and only sheet to paste, and to paste in the last row of data + 1 (so the first empty row based on column A)

Sub cp()
    Dim eWorkbook, iWorkbook As Workbook
        Set eWorkbook = ThisWorkbook
    Dim i, z As Long
    Dim iWorkbookImportOpen As Variant


    Application.DisplayAlerts = False: Application.AskToUpdateLinks = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    ChDir eWorkbook.Path
    iWorkbookImportOpen = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xlsx; *.xlsm; *.xls; *.xltm), *.xlsx; *.xlsm; *.xls; *.xltm", _
                                    Title:="Select Import File", MultiSelect:=True)
                                    On Error GoTo ExitSub
        For i = LBound(iWorkbookImportOpen) To UBound(iWorkbookImportOpen)
            Set iWorkbook = Workbooks.Open(Filename:=iWorkbookImportOpen(i), ReadOnly:=True)
            With iWorkbook.Worksheets(1).Range("C2:C200").Copy: End With
                With eWorkbook.Worksheets(1)
                    z = eWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
                    .Cells(z, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                End With
            iWorkbook.Close SaveChanges:=False
        Next i
    Application.DisplayAlerts = True: Application.AskToUpdateLinks = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
    MsgBox ("done")
ExitSub: Exit Sub
End Sub

 

[zacuk]

Hi,

Thanks for the macro. When I tried to run it, it gave 'Run-time Error 76. Path not found'.

Would be great if you could add comment (using ') to specify what information do I need to change (such as where to put file path etc). Do I have to add path somewhere in the macro, like this: C:\2017\9. September\Data ??

I am not good at macros, but i can run them and have a little ability to manipulate them.

Some more information on what I want to do is here in my original post which no one has replied to so far: https://www.mrexcel.com/forum/excel...ew-excel-files-stored-year-month-folders.html

Thanks

 

[bsquad]

Are you adding any additional code to this over have any Name Manager reference?, formulas referring to a Name Manger reference? or adding the code I posted in addition to existing code?
The code does not actually designate the file path until you choose the file to import, therefore cannot ever have incorrect file path. However, 2 things come to mind; if you are using only the code I had posted and still getting that error, try removing

ChDir eWorkbook.Path

or commenting it out.
Otherwise it may be a security measure with your company, but I wouldn't think it would be the case.

Sub cp()
    Dim eWorkbook, iWorkbook As Workbook
        Set eWorkbook = ThisWorkbook
    Dim i, z As Long
    Dim iWorkbookImportOpen As Variant


    'THIS TURNS OFF ANY ALERT BOXES (TEMPORARILY) THAT MAY INTERFERE WITH THE IMPORT PROCESS
    Application.DisplayAlerts = False: Application.AskToUpdateLinks = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    
    'SETS THE DEFAULT OF WHAT FOLDER OR PATH THE DIALOG BOX STARTS IN
    ChDir eWorkbook.Path
    
    'PROMPTS THE DIALOG BOX - FILTERS ON EXCEL FILES ONLY
    iWorkbookImportOpen = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xlsx; *.xlsm; *.xls; *.xltm), *.xlsx; *.xlsm; *.xls; *.xltm", _
                                    Title:="Select Import File", MultiSelect:=True)
                                    On Error GoTo ExitSub
                                    
    'SINCE MULTISELECT IS TRUE - LBOUND = LOWEST NUMBER OF THE WORKBOOKS SELECTED WHICH IS ALWAYS 1, UBOUND IS THE HIGHEST NUMBER OF THE WORKBOOKS SELECTED
        For i = LBound(iWorkbookImportOpen) To UBound(iWorkbookImportOpen)
        
    'DECLARES THE CURRENT IMPORT WORKBOOK IN THE CYCLE AND OPENS AS A READ ONLY
            Set iWorkbook = Workbooks.Open(Filename:=iWorkbookImportOpen(i), ReadOnly:=True)
            
    'ON THE IMPORTED WORKBOOK, ON THE FIRST WORKSHEET, COPY C2:C200
            With iWorkbook.Worksheets(1).Range("C2:C200").Copy: End With
            
    'ON THE MASTER / END WORKBOOK, FIND THE LAST ROW IN COLUMN A, TAKE THAT ROW NUMBER, ADD 1 TO IT, DESIGNATE MY PASTE CELL AS THAT ROW AND TRANSPOSE THE DATA
    'INCLUDING THE HYPERLINKS AND FORMATTING
                With eWorkbook.Worksheets(1)
                    z = eWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
                    .Cells(z, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                End With
                
    'CLOSE THE CURRENT IWORKBOOK/IMPORT WORKBOOK WITHOUT SAVING
            iWorkbook.Close SaveChanges:=False
            
    'MOVES TO THE NEXT IMPORT WORKBOOK IF THERE WERE MULTIPLE WORKBOOKS SELECTED IN THE DIALOG BOX
        Next i
        
    'TURNS BACK ON ANY EXCEL ALERTS
    Application.DisplayAlerts = True: Application.AskToUpdateLinks = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
    MsgBox ("done")
ExitSub: Exit Sub
End Sub

 

[zacuk]

Hi,

Thanks for looking into it further.

Initialy it gave error, but when I removed "ChDir eWorkbook.Path" the error message did not appear anymore and the macro did ask me to locate the file.

However, as soon as I clicked on the Excel file, it just displayed something in a row in the destination file. The pasted values are not making sense to me!! Also, there are multiple tabs in the Excel file from which I want to extract the column. The column is located in the tab XYZ.

In nutshell, the macro did not ask me to locate the tab (XYZ) and, secondly, it pasted the values in the next free row (whereas, I want it to paste the row where the curser is).

Thanks

 

[bsquad]

ok, so when you say XYZ tab, I have no idea what you are talking about, be specific when explaining, you never mentioned initially you needed it from multiple tabs. I brought that up in my second post. Please be more thorough.

 

[zacuk]

Thanks for your reply and apologies for the confusion.

'XYZ' is the tab name. There are other tabs which I am not interested in, please.

The only requirement is to copy cells C2:C200 from the tab XYZ into the Excel file containing the macro, at the row where the curser is (the selected row), please. The other thing to remember is to keep the link intact so that any changes in the original file get transferred across to the destination file, please. Thanks