halimi1306
08-02-2011, 10:24 PM
Hi,
How to copy specific tab from ws. For example I want to copy "Summary-GNI" and "Summary-Capital" only from the slave. The code below will import all tabs in ws.
Thanks.
Option Explicit
Public Sub ImportSheetData()
Dim sFld As String, sFlPath As String, sFile As String
Dim vPath As Variant
Dim wb As Workbook, wbThisBk As Workbook
Dim ws As Worksheet
Dim i As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'For calling the deletion sub
Call DeleteOldSheets
Set wbThisBk = ThisWorkbook
'Getting the path
sFlPath = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If sFlPath = "False" Then
MsgBox "No Files Selected"
Exit Sub
Else
vPath = Split(sFlPath, "\")
sFld = ""
For i = LBound(vPath) To UBound(vPath)
If InStr(1, vPath(i), ".xls") = 0 Then
sFld = sFld & vPath(i) & "\"
End If
Next i
ChDir sFld
sFile = Dir("*.xls*")
Do While sFile <> ""
Set wb = Workbooks.Open(sFld & sFile)
For Each ws In wb.Sheets
ws.Copy Before:=wbThisBk.Sheets("End")
Next ws
wb.Close False
sFile = Dir
Loop
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub DeleteOldSheets()
'Deleting old worksheets except Model Engine, Guidelines, Macro Control, Summary Dashboard and End
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
Select Case ws.Name
Case "Model Engine (Read Only)", "Guidelines (Read Only)", "Macro Control (Read Only)", "Summary Dashboard", "End"
'do nothing
Case Else
ws.Delete
End Select
Next ws
End Sub
How to copy specific tab from ws. For example I want to copy "Summary-GNI" and "Summary-Capital" only from the slave. The code below will import all tabs in ws.
Thanks.
Option Explicit
Public Sub ImportSheetData()
Dim sFld As String, sFlPath As String, sFile As String
Dim vPath As Variant
Dim wb As Workbook, wbThisBk As Workbook
Dim ws As Worksheet
Dim i As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'For calling the deletion sub
Call DeleteOldSheets
Set wbThisBk = ThisWorkbook
'Getting the path
sFlPath = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If sFlPath = "False" Then
MsgBox "No Files Selected"
Exit Sub
Else
vPath = Split(sFlPath, "\")
sFld = ""
For i = LBound(vPath) To UBound(vPath)
If InStr(1, vPath(i), ".xls") = 0 Then
sFld = sFld & vPath(i) & "\"
End If
Next i
ChDir sFld
sFile = Dir("*.xls*")
Do While sFile <> ""
Set wb = Workbooks.Open(sFld & sFile)
For Each ws In wb.Sheets
ws.Copy Before:=wbThisBk.Sheets("End")
Next ws
wb.Close False
sFile = Dir
Loop
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub DeleteOldSheets()
'Deleting old worksheets except Model Engine, Guidelines, Macro Control, Summary Dashboard and End
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
Select Case ws.Name
Case "Model Engine (Read Only)", "Guidelines (Read Only)", "Macro Control (Read Only)", "Summary Dashboard", "End"
'do nothing
Case Else
ws.Delete
End Select
Next ws
End Sub