Use Input boxes to pick existing workbook and existing sheets in the workbook

Andy15

Board Regular
Joined
Apr 1, 2017
Messages
56
Hi Guys,

I have some code that copies some columns of data based on the text typed into an input box. Code below is working great.

What I would like to achieve if possible is 2 more input boxes asking for the destination workbook name and also the sheet name within the destination workbook.

The code will then open the destination workbook and relevant sheet then copy the columns of data from master workbook and paste them into the chosen destination workbook sheets, appending any data already existing.

The workbook and the necessary sheet names will all ready exist.

Thanks




[/CODE]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
'If Sheet.Name <> "SEARCH" Then 'this can be deleted when copying to a new workbook
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
'End If 'this can be deleted when copying to a new workbook
Set Cell = Nothing
Next Sheet
'


'AutoFit All Columns on Worksheet
wkb.Worksheets(1).Cells.EntireColumn.AutoFit

Application.ScreenUpdating = True






End Sub



[/CODE]
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Forum statistics

Threads
1,214,925
Messages
6,122,301
Members
449,078
Latest member
nonnakkong

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