Copy Selected workbook/worksheet with specific data into another

[Closed]
Report
Posts
1
Registration date
Tuesday April 21, 2015
Status
Member
Last seen
April 21, 2015
-
Hi,

I plan to copy selected workbook and sheets listed in the ListBox where it will copy data at cells(52, "R") into another workbook with sheets("NetOil_March").Cells(j, "B"). row j acts as findDate same with selected worksheets date on cells(4, "E").
Steps taken:
1. I want to create a button that browse worksheet and put the listed sheets in the ListBox.
2. From the ListBox, the user can select the sheets that can then a button2 can ran a macro to copy selected data.

For the first step, I managed to use auto find workbook in CommandButton1 code. But for second step, I got run time error '9': subscript out of range in CommandButton2 'FindDate = Wkb.Worksheets(WksName).Cells(4, "E").Value'

Can somebody please help me. Need to settle the assignment in a week.

Private Sub CommandButton1_Click()

' <<<To find the workbook>>>

Dim wbCurFile As Workbook, wbOpened As Workbook
Dim cCurPath As String, fileToOpen As Variant
Dim iCtr As Long

On Error GoTo errTrap

Set wbCurFile = ThisWorkbook
cCurPath = wbCurFile.Path

ChDir cCurPath

fileToOpen = Application.GetOpenFilename("Excel Workbook (*.xlsm), *.xlsm")

If fileToOpen <> False Then

' open the file
Application.ScreenUpdating = False
Workbooks.Open Filename:=fileToOpen

' store name so that it can be referred
Set wbOpened = ActiveWorkbook

If wbOpened Is Nothing Then Exit Sub

Me.ListBox1.MultiSelect = fmMultiSelectSingle

For iCtr = 1 To wbOpened.Sheets.Count
With Sheets(iCtr)
If .Visible = xlSheetVisible Then
Me.ListBox1.AddItem .Name
End If
End With
Next iCtr

Else
' Cancel
Dim MsgAnswer As Variant
MsgAnswer = MsgBox("Import Cancelled.", vbInformation, "Import Cancelled ")
End If

errTrap:
If Err.Number <> 0 Then MsgBox "Error Number - " & Err.Number & vbCr & _
"Error Description - " & Err.Description & vbCr & vbCr & _
"An error has occurred!", , "Error"
Exit Sub
End Sub

Private Sub CommandButton2_Click()

'<<<<Importing Selected Worksheet>>>>
Dim Wkb As Workbook
Dim WksName As String
Dim N As String
Dim j As Long
Dim lastrow2 As Long
Dim FindDate As String
'Dim FindDate As Long

Set Wkb = ActiveWorkbook

'To copy selected workbook and place worksheet into listbox
With ListBox1
If .ListIndex = -1 Then Exit Sub
WksName = .List(.ListIndex) 'List Tab in workbook selected will appear
N = Wkb.Name
Wkb.Worksheets(WksName).Copy Before:=ThisWorkbook.Worksheets("Field Reading")
End With

'Copy Specific Data from selected worksheet in the listbox into this workbook.
FindDate = Wkb.Worksheets(WksName).Cells(4, "E").Value 'Run time error '9' Subscript out of range
ThisWorkbook.Sheets("NetOil_March").Activate
lastrow2 = ThisWorkbook.Sheets("NetOil_March").Range("A" & Rows.Count).End(xlUp).Row

For j = 3 To lastrow2
If ThisWorkbook.Sheets("NetOil_March").Cells(j, "A").Value = FindDate Then
Wkb.Worksheets(WksName).Cells(52, "R").Copy

ThisWorkbook.Sheets("NetOil_March").Activate
ThisWorkbook.Sheets("NetOil_March").Cells(j, "B").PasteSpecial xlPasteValues
End If

Next j
Application.CutCopyMode = False

ThisWorkbook.Sheets("NetOil_March").Activate
Wkb.Close Savechanges:=False

End Sub