Use input box to select destination workbook and sheet name for pasting data.

[Andy15]

Hello everyone, i am in need of a little bit of help. I have searched google and many forums for pointers but do not seem to be able to find what I need.


I have the vba code for looping through and copying columns of data from a "master workbook" with multiple sheets to a new workbook, but what I would like to do is allow the user to choose the destination workbook and also the destination sheet name by using an input box.


The destination workbook and the necessary worksheets will already exist and be stored on a location in the same folder as the master workbook.


Thanks for any help

 

[Norie]

You wouldn't really be able to use a simple InputBox for that.

First you would need to return all the workbooks in the folder, list them and then have the user select one.

Then you would need to list all the worksheets in the selected workbook.

What you are probably looking for is a userform that could be set up to do all this.

Is that what you want?

 

[Andy15]

Yes if it will do what I need.

Thanks

 

[Andy15]

This is my code so far which does what i require as far as copying the relevant data to a new workbook. As I have hopefully explained I want to copy the data to an existing workbook and specific sheet within that workbook, the data will be pasted after any existing data.

Hope this makes sense

Option Explicit Option Compare Text '< ignore case
 '
Sub Searchcolumns()
'
    Dim FirstAddress As String, WhatFor As String
    Dim Cell As Range, Sheet As Worksheet
    Dim wkb As Workbook




    
    Do
        WhatFor = InputBox("What are you looking for?", "Search Criteria")
        If StrPtr(WhatFor) = 0 Then Exit Sub
    Loop Until Len(WhatFor) > 0
    
    Application.ScreenUpdating = False
    
'Will add new workbook
    Set wkb = Workbooks.Add(1)
'
    For Each Sheet In ThisWorkbook.Worksheets
            With Sheet.Rows(2)
                Set Cell = .Find(WhatFor, LookIn:=xlValues, LookAt:=xlPart)
                If Not Cell Is Nothing Then
                    FirstAddress = Cell.Address
                    Do
                        
                        Sheet.Range("A1").EntireColumn.Copy _
                        Destination:=wkb.Sheets(1).Cells(1, wkb.Sheets(1).Columns.Count).End(xlToLeft).Offset(0, 1)
                        Sheet.Range("B1").EntireColumn.Copy _
                        Destination:=wkb.Sheets(1).Cells(1, wkb.Sheets(1).Columns.Count).End(xlToLeft).Offset(0, 1)
                        
                        Cell.EntireColumn.Copy _
                        Destination:=wkb.Sheets(1).Cells(1, wkb.Sheets(1).Columns.Count).End(xlToLeft).Offset(0, 1)
                        
                        Set Cell = .FindNext(Cell)
                        
                    Loop Until Cell.Address = FirstAddress
                End If
            End With
        Set Cell = Nothing
    Next Sheet
'
        
        
'AutoFit All Columns on Worksheet
    wkb.Worksheets(1).Cells.EntireColumn.AutoFit
        
    Application.ScreenUpdating = True




        
End Sub

Thanks