It has been some time since I last looked at any VBA and most of what I do know has been self taught and learned from here and various web searched and samples.
And I’m trying to create a userform that includes a listbox of all worksheet names. And then the user will choose another workbook, call in workbook B that should have the same identical worksheet names. The script would then look at items/worksheets the user chose from the listbox, and then for each of those worksheets, look in the Workbook B and copy specific ranges from each worksheet into the existing worksheet.
Essentially, I want to copy/paste special value various data, worksheet ranges from one workbook to another. The 2 workbooks should always be identical with the same worksheets. I really cannot copy the entire worksheet from one to the other as there are a lot of formulas and named ranges involved and I think that would begin break various other things in the workbook.
Below is my current userform code that I have from some past help/code, and this will generate the listbox and create an array of the sheet names selected. But I’m stuck from there on how open the other workbook to compare sheetnames and then copy/paste special value.
Option Explicit
Private Sub Cancel_Click()
Unload Me
End Sub
Private Sub GetWorkBook_Click()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Please select the file."
.Filters.Clear
.Filters.Add "Excel 2010", "*.xlsx"
.Filters.Add "All Files", "*.*"
If .Show = True Then
TextBox1 = .SelectedItems(1) 'replace txtFileName with your textbox
'TextBox1 = Mid(.SelectedItems(1), InStrRev(.SelectedItems(1), "\") + 1)
End If
End With
End Sub
Private Sub ImportWps_Click()
'Import Workpaper
Dim wbk As Workbook
Dim Msg As String
Dim SheetsFound() As String
ReDim SheetsFound(0)
Dim i, x As Long
Application.ScreenUpdating = False
'Hard coded for now, should be getting file from textbox1
'Will need to add check to ensure that file is not open
'wbk = Application.Workbooks.Open("C:\Data\Testing.xlsx")
x = 0
Msg = "You selected" & vbNewLine
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
Msg = Msg & ListBox1.List(i) & vbNewLine
End If
Next i
MsgBox Msg
'Creates an array of the sheets selected.
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
SheetsFound(UBound(SheetsFound)) = ListBox1.List(i)
ReDim Preserve SheetsFound(UBound(SheetsFound) + 1)
x = x + 1
End If
Next i
'For each worksheet selected, check if worksheet exists in the file (it should)
'If match found, then copy that sheets specific data range into worksheet of
'same name in existing file
'Just a counter on the above if nothing selected from listbox
If x = 0 Then
MsgBox "No Workpapers Selected"
Exit Sub
End If
Unload ImportWorkPapers
Application.ScreenUpdating = True
Sheets("Background").Select
End Sub
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Me.ListBox1.Clear
For Each ws In ActiveWorkbook.Worksheets
'WorkSheet Must be Visible and can not include Chart or other specific WorkSheets
If ws.Visible = True And Not ws.Name Like "*Charts*" And ws.Name <> "NamedRanges" And ws.Name <> "DropDowns" And ws.Name <> "ChartLinks" And ws.Name <> "Report Comments" Then
Me.ListBox1.AddItem ws.Name
End If
Next ws
End Sub
Bookmarks