jordanburch
Active Member
- Joined
- Jun 10, 2016
- Messages
- 439
- Office Version
- 2016
hey guys,
I have the following code that is messing up. It needs to search for each worksheet name and then import that worksheet. The issue is that one workbook has two worksheets that need to be imported and its not importing both worksheets because I think it finds it and then closes the file and then moves to the next file. Can you help me have it search each file for each worksheet name and import all the data?
Any helps is appreciated!
Jordan
I have the following code that is messing up. It needs to search for each worksheet name and then import that worksheet. The issue is that one workbook has two worksheets that need to be imported and its not importing both worksheets because I think it finds it and then closes the file and then moves to the next file. Can you help me have it search each file for each worksheet name and import all the data?
VBA Code:
Sub DRPimport1()
Dim MyFile As String
Dim erow As Long
Dim Filepath As String
Dim wb1 As Workbook, wb2 As Workbook
Dim data_wbk2 As String
Dim data_wbk6 As String
Dim fn As String
Dim fn2 As String
Dim fn3 As String
Dim ShtName1 As String
Dim ShtName2 As String
Dim ShtName3 As String
Dim ShtName4 As String
ShtName1 = "Details"
ShtName2 = "Detail"
ShtName3 = "Detail - DRP"
ShtName4 = "Detail - DRP Reversal"
data_wbk2 = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
fn = Left(data_wbk2, 6)
fn2 = Right(data_wbk2, 2)
fn3 = Right(data_wbk6, 2)
Application.ScreenUpdating = False
Worksheets.Add.Name = "DRP"
Set wb1 = ThisWorkbook
MsgBox "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\" & "20" & fn2 & " " & "DRP" & "\" & "20" & fn2 & "-" & fn3 & " " & "Reporting Cycle" & "\"""
Filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\" & "20" & fn2 & " " & "DRP" & "\" & "20" & fn2 & "-" & fn3 & " " & "Reporting Cycle" & "\"
'K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\2020 DRP\2020-05 Reporting Cycle
MyFile = Dir(Filepath & "*.xls*")
Do While Len(MyFile) > 0 And MyFile <> "suspense automation.xlsm"
erow = wb1.Sheets("DRP").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Set wb2 = Workbooks.Open(Filepath & MyFile)
With wb2
Dim ShtName As String
ShtName = "Sheet 1"
If Evaluate("isref('" & ShtName & "'!A1)") Then
'sheet exists do something
Else
'sheet doesn't exist do something else
End If
If Evaluate("isref('" & ShtName1 & "'!A1)") Then
.Sheets("Details").AutoFilterMode = False
.Sheets("Details").Range("d2:af1000").Copy Destination:=wb1.Worksheets("DRP").Cells(erow, 1)
.Close savechanges:=False
ElseIf Evaluate("isref('" & ShtName3 & "'!A1)") Then
.Sheets("Detail - DRP").AutoFilterMode = False
.Sheets("Detail - DRP").Range("c2:af1000").Copy Destination:=wb1.Worksheets("DRP").Cells(erow, 1)
.Close savechanges:=False
ElseIf Evaluate("isref('" & ShtName2 & "'!A1)") Then
.Sheets("Detail").AutoFilterMode = False
.Sheets("Detail").Range("c2:af1000").Copy Destination:=wb1.Worksheets("DRP").Cells(erow, 1)
.Close savechanges:=False
ElseIf Evaluate("isref('" & ShtName4 & "'!A1)") Then
.Sheets("Detail - DRP Reversal").AutoFilterMode = False
.Sheets("Detail - DRP Reversal").Range("c2:af1000").Copy Destination:=wb1.Worksheets("DRP").Cells(erow, 1)
.Close savechanges:=False
End If
End With
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Any helps is appreciated!
Jordan
Last edited: