Copy and paste multiple ws from wb1 to corresponding ws on wb2

[si3po]

Hi All,I'm relatively new to VBA and am reintroducing myself to it again now after a short hiatus.My current situation sees me compiling and producing reports based on data we get output from Oracle datatbases. Currently we run an Oracle report that contains multiple worksheets and export them to desktop as an Excel XLS format. Once opened in Excel, we manually copy and paste the data on each sheet from the oracle reports to their corresponding worksheet on our main Reporting Workbook called 'KPIs' overwriting all existing data held on those sheets.There are roughly 10 or 12 worksheets created by the Oracle report, and finishing a manual copy/paste of this data to the existing workbook takes one person in excess of half an hour each day - then along come I saying "there must be an easier way to do this with Excel VBAs".I wrote this little bit of code, but it doesn't quite work as expected...

Sub ImportData()
   Dim wb1 As Workbook
   Dim wb2 As Workbook
   Dim Sheet As Worksheet
   Dim PasteStart As Range
   Set wb1 = ActiveWorkbook
   Set PasteStart = [Alerts!A4]
   'this section selects the first KPI sheet to copy to
   Sheets("Alerts").Select
   LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
   Range("A4:E" & LastRow).Select
   Selection.ClearContents
   'this section opens the Oracle report saved to your PC
   FileToOpen = Application.GetOpenFilename _
      (title:="Please choose a Report to Parse", _
      FileFilter:="Report Files *.xls (*.xls),")
   If FileToOpen = False Then
      MsgBox "No File Specified.", vbExclamation, "ERROR"
      Exit Sub
      'this section selects the data on Oracle report and pasts to the KPI sheets
   Else
      Set wb2 = Workbooks.Open(fileName:=FileToOpen)
      LastRow = ActiveSheet.Range("A2" & Rows.Count).End(xlUp).Row
      Range("A2:Z" & LastRow).Select
      For Each Sheet In wb2.Sheets
         With Sheet.UsedRange
            .Copy PasteStart
            Set PasteStart = PasteStart.Offset(.Rows.Count)
         End With
      Next Sheet
   End If
   wb2.Close
End Sub

As you can see, the above is run from within the main KPI Workbook that needs fresh data every morning. As the workbook can be updated by anybody, I built in a manual open dialog for the user to find the file they need to copy from (usually on their desktop, but you never know!). It then selects the first sheet on the KPI wb and clears the existing data.The final section of the code was expected to select the data to copy from the Oracle wb sheets and paste this into their corresponding worksheets on the KPI wb.What I actually get is that ALL the ws from the Oracle wb are pasted into the first ws on my main KPI wb - called 'Alerts'.I hop I haven't made this too complicated, but could somebody please point me in the right direction?

 

[NdNoviceHlp]

Hi si3po and Welcome to the Board! You need to be more specific with your copy and pasting re. where the data is and where U want it to go. Here's a link that should get U started. HTH. Dave
https://www.mrexcel.com/forum/excel-questions/1077924-loop-through-formula-macro-6.html

 

[si3po]

Hi si3po and Welcome to the Board! You need to be more specific with your copy and pasting re. where the data is and where U want it to go. Here's a link that should get U started. HTH. Davehttps://www.mrexcel.com/forum/excel-questions/1077924-loop-through-formula-macro-6.html

Thanks Dave, it certainly does help, a little... but i'll work my way through the code in that post and try to remedy my problem with that.
Would you say that I am going in the right direction with my original code, and that my downfall is the final section of VBA that pastes the data into my existing WB? I'm just at the point of trying to narrow down my errors and focus in on a solution rather than re-writing the entire code.
thanks again, Si

 

[NdNoviceHlp]

Just narrow down the code in that thread to just the 1 file. It demonstrates how to copy and paste specific data from 1 specific file location to another specific file location. You likely won't need to worry about clipboard errors or using an array for speed. Give it a go and I'm sure someone will be able to help U along. Dave

 

[NdNoviceHlp]

Hi Si. It is a bit more complex than I initially thought. U didn't say what ranges U wanted transferred. This code clears the contents of each of your open wb sheets range "A4:E" & LastRow then copies each sheet from your selected wb (range "A4:E" & LastRow) to the same named sheet in your open wb to the same range. Give it a test and report back. Dave

Option Explicit
Sub test()
Dim LastRow As Double, sht1 As Worksheet, sht2 As Worksheet
Dim Wb2 As Object, FileToOpen As String
On Error GoTo Erfix
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.xls (*.xls),")
If FileToOpen = vbNullString Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
'this section selects the data on Oracle report and pasts to the KPI sheets
Else
Set Wb2 = Workbooks.Open(Filename:=FileToOpen)
For Each sht1 In ThisWorkbook.Sheets
LastRow = sht1.Range("A" & Rows.Count).End(xlUp).Row
sht1.Range("A4:E" & LastRow).ClearContents
For Each sht2 In Workbooks(Wb2.Name).Sheets
If sht1.Name = sht2.Name Then
LastRow = sht2.Range("A" & Rows.Count).End(xlUp).Row
Workbooks(Wb2.Name).Sheets(sht2.Name).Range("A4:E" & LastRow).Copy
ThisWorkbook.Sheets(sht1.Name).Cells(4, "A").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Exit For
End If
Next sht2
Next sht1
Workbooks(Wb2.Name).Close SaveChanges:=False
End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Set Wb2 = Nothing
Exit Sub

Erfix:
On Error GoTo 0
MsgBox "Error"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Set Wb2 = Nothing
End Sub

 

[si3po]

Hi Si. It is a bit more complex than I initially thought. U didn't say what ranges U wanted transferred. This code clears the contents of each of your open wb sheets range "A4:E" & LastRow then copies each sheet from your selected wb (range "A4:E" & LastRow) to the same named sheet in your open wb to the same range. Give it a test and report back. Dave

Option ExplicitSub test()Dim LastRow As Double, sht1 As Worksheet, sht2 As WorksheetDim Wb2 As Object, FileToOpen As StringOn Error GoTo ErfixApplication.DisplayAlerts = FalseApplication.ScreenUpdating = FalseApplication.Calculation = xlCalculationManualFileToOpen = Application.GetOpenFilename _(Title:="Please choose a Report to Parse", _FileFilter:="Report Files *.xls (*.xls),")If FileToOpen = vbNullString ThenMsgBox "No File Specified.", vbExclamation, "ERROR"Exit Sub'this section selects the data on Oracle report and pasts to the KPI sheetsElseSet Wb2 = Workbooks.Open(Filename:=FileToOpen)For Each sht1 In ThisWorkbook.SheetsLastRow = sht1.Range("A" & Rows.Count).End(xlUp).Rowsht1.Range("A4:E" & LastRow).ClearContentsFor Each sht2 In Workbooks(Wb2.Name).SheetsIf sht1.Name = sht2.Name ThenLastRow = sht2.Range("A" & Rows.Count).End(xlUp).RowWorkbooks(Wb2.Name).Sheets(sht2.Name).Range("A4:E" & LastRow).CopyThisWorkbook.Sheets(sht1.Name).Cells(4, "A").PasteSpecial Paste:=xlPasteValuesApplication.CutCopyMode = FalseExit ForEnd IfNext sht2Next sht1Workbooks(Wb2.Name).Close SaveChanges:=FalseEnd IfApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueApplication.Calculation = xlAutomaticSet Wb2 = NothingExit SubErfix:On Error GoTo 0MsgBox "Error"Application.DisplayAlerts = TrueApplication.ScreenUpdating = TrueApplication.Calculation = xlAutomaticSet Wb2 = NothingEnd Sub

Hi Dave,Thanks for your assistance in this, but it seems there might be an anomaly somewhere. I've copied and pasted your code verbatim into my 'This Workbook' on VBA, but on first run of the code I encountered the 'Error' dialog without any error description. Could this be because I have all of the worksheets on my KPI report hidden to prevent other users accessing them directly - currently the only way an user can see any of these worksheets is via a button link on a dashboard type page.

 

[NdNoviceHlp]

The code can go where U put it and I don't think the sheets can be hidden unless coded to be unhidden. Maybe for testing this would be better. Unhide the sheets and test then let me know what line of code errors. Dave

Option Explicit
Public Sub test()
Dim LastRow As Double, sht1 As Worksheet, sht2 As Worksheet
Dim Wb2 As Object, FileToOpen As String
'On Error GoTo Erfix
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.xls (*.xls),")
If FileToOpen = vbNullString Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
'this section selects the data on Oracle report and pasts to the KPI sheets
Else
Set Wb2 = Workbooks.Open(Filename:=FileToOpen)
For Each sht1 In ThisWorkbook.Sheets
LastRow = sht1.Range("A" & Rows.Count).End(xlUp).Row
sht1.Range("A4:E" & LastRow).ClearContents
For Each sht2 In Workbooks(Wb2.Name).Sheets
If sht1.Name = sht2.Name Then
LastRow = sht2.Range("A" & Rows.Count).End(xlUp).Row
Workbooks(Wb2.Name).Sheets(sht2.Name).Range("A4:E" & LastRow).Copy
ThisWorkbook.Sheets(sht1.Name).Cells(4, "A").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Exit For
End If
Next sht2
Next sht1
Workbooks(Wb2.Name).Close SaveChanges:=False
End If

'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
'Application.Calculation = xlAutomatic
Set Wb2 = Nothing
Exit Sub

Erfix:
On Error GoTo 0
MsgBox "Error"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Set Wb2 = Nothing
End Sub

 

[si3po]

morning All,With Dave's (NdNoviceHlp) assistance, I've managed to get the below code adjusted a little to suit my requirements, however I'm getting a "Runtime Error 9 : Subscript Out Of Range" error when it runs.

Option ExplicitPublic Sub Import_Data()Dim LastRow As Double, sht1 As Worksheet, sht2 As WorksheetDim Wb2 As Object, FileToOpen As String'On Error GoTo Erfix'Application.DisplayAlerts = False'Application.ScreenUpdating = False'Application.Calculation = xlCalculationManualFileToOpen = Application.GetOpenFilename _(Title:="Please choose a Report to Parse", _FileFilter:="Report Files *.xls (*.xls),")If FileToOpen = vbNullString ThenMsgBox "No File Specified.", vbExclamation, "ERROR"Exit Sub'this section selects the data on Oracle report and pasts to the KPI sheetsElseSet Wb2 = Workbooks.Open(Filename:=FileToOpen)For Each sht1 In ThisWorkbook.Worksheets(Array("Alerts", "Alert Details", "No Locat", "Temp Ser No", "Need Event", "Life Ex", "XC", "AinU#", "No Move", "XP", "E1 Stock", "XR", "Comitted Stock", "Stored Demands", "NO PSHG", "CREF", "R4 L STORES", "Offline Demands")).SelectLastRow = sht1.Range("A" & Rows.Count).End(xlUp).Rowsht1.Range("A4:E" & LastRow).ClearContentsFor Each sht2 In Workbooks(Wb2.Name).SheetsIf sht1.Name = sht2.Name ThenLastRow = sht2.Range("A" & Rows.Count).End(xlUp).RowWorkbooks(Wb2.Name).Sheets(sht2.Name).Range("A4:E" & LastRow).CopyThisWorkbook.Sheets(sht1.Name).Cells(4, "A").PasteSpecial Paste:=xlPasteValuesApplication.CutCopyMode = FalseExit ForEnd IfNext sht2Next sht1Workbooks(Wb2.Name).Close SaveChanges:=FalseEnd If'Application.DisplayAlerts = True'Application.ScreenUpdating = True'Application.Calculation = xlAutomaticSet Wb2 = NothingExit SubErfix:On Error GoTo 0MsgBox "Error"Application.DisplayAlerts = TrueApplication.ScreenUpdating = TrueApplication.Calculation = xlAutomaticSet Wb2 = NothingEnd Sub

As far as I can see, there's no highlighted line on the debugger detailing where the error is, however I can run the code without issue to this line

For Each sht1 In ThisWorkbook.WorkSheets(Array(.........

so I assume that my selection array is causing the problem, however I have many other sheets within my workbook that need to remain untouched by the code. Can anybody return me to the tracks and get this back up and running please?regards,Si3po

 

[NdNoviceHlp]

The code works without errors IF the sheets in your array exist in your wb, if they don't U get the error U listed. Check your spelling and/or the existence of the sheets listed in your array. Also, please use to learn code tags. HTH. Dave

Option Explicit
Public Sub Import_Data()
Dim LastRow As Double, sht1 As Worksheet, sht2 As Worksheet
Dim Wb2 As Object, FileToOpen As String
'On Error GoTo Erfix
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.xls (*.xls),")
If FileToOpen = vbNullString Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub 'this section selects the data on Oracle report and pasts to the KPI sheets
Else
Set Wb2 = Workbooks.Open(Filename:=FileToOpen)
For Each sht1 In ThisWorkbook.Worksheets(Array("Alerts", "Alert Details", "No Locat", "Temp Ser No", "Need Event", "Life Ex", "XC", "AinU#", "No Move", "XP", "E1 Stock", "XR", "Comitted Stock", "Stored Demands", "NO PSHG", "CREF", "R4 L STORES", "Offline Demands"))
LastRow = sht1.Range("A" & Rows.Count).End(xlUp).Row
sht1.Range("A4:E" & LastRow).ClearContents
For Each sht2 In Workbooks(Wb2.Name).Sheets
If sht1.Name = sht2.Name Then
LastRow = sht2.Range("A" & Rows.Count).End(xlUp).Row
Workbooks(Wb2.Name).Sheets(sht2.Name).Range("A4:E" & LastRow).Copy
ThisWorkbook.Sheets(sht1.Name).Cells(4, "A").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Exit For
End If
Next sht2
Next sht1
Workbooks(Wb2.Name).Close SaveChanges:=False
End If
'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
'Application.Calculation = xlAutomatic
Set Wb2 = Nothing
Exit Sub
Erfix: On Error GoTo 0
MsgBox "Error"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Set Wb2 = Nothing
End Sub