VBA to Open Excel File and Paste Sheet 1 Data into "RRimport" Sheet in Current Workbook - vba

Ok so I have a current workbook (Original Workbook) with several Sheets. I would like to open an existing workbook (Data Workbook) and copy all of the contents in Sheet 1 of 'Data Workbook', then paste everything into Sheet "RRimport" of 'Original Workbook'. At the end of this process I would like to close the 'Data Workbook' So far I have the following code, however it currently pastes a new sheet right after my sheet names "ARGimport" of my Original Workbook:
Sub ImportData()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = ActiveWorkbook
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
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
For Each Sheet In wb2.Sheets
If Sheet.Visible = True Then
Sheet.Copy After:=wb1.Sheets("ARGimport")
End If
Next Sheet
End If
wb2.Close
End Sub
Thanks to the help of rdhs I was able to figure this out. Updated and working code below:
Sub ImportData()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range
Set wb1 = ActiveWorkbook
Set PasteStart = [RRimport!A1]
Sheets("RRimport").Select
Cells.Select
Selection.ClearContents
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
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
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

Does this do what you want?
Sub ImportData()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range
Set wb1 = ActiveWorkbook
Set PasteStart = [RRimport!A1]
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
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
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

Related

How to stop internal links from turning to #REF?

I have a tab (Tab A) in my workbook that has links to another tab (Tab B and Tab C) that VBA inserts with Application.GetOpenFilename. When I run the macro I get #REF! in Tab A for the formulas on that tab (the formulas reference the inserted tabs ie Tab B and Tab C). How can I prevent this from happening and to keep the formulas on Tab A intact?
Here is my code:
Sub Data_Tab()
'
' Data Tab Macro
Dim ws As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long
Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("CC_DMSR").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "CC_DMSR"
Application.DisplayAlerts = True
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range
Set wb1 = ActiveWorkbook
Set PasteStart = [CC_DMSR!A1]
Sheets("CC_DMSR").Select
Cells.Select
Selection.ClearContents
MsgBox "Please select the CC DMSR File"
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.xlsx (*.xlsx),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
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
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Submitted_DMSR").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Submitted_DMSR"
Application.DisplayAlerts = True
Set wb1 = ActiveWorkbook
Set PasteStart = [Submitted_DMSR!A1]
Sheets("Submitted_DMSR").Select
Cells.Select
Selection.ClearContents
MsgBox "Please select the Submitted DMSR File"
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.xlsx (*.xlsx),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
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
ActiveWorkbook.RefreshAll
ActiveSheet.PivotTables("PivotTable2").PivotCache.MissingItemsLimit = _
xlMissingItemsNone
ActiveSheet.PivotTables("PivotTable1").PivotCache.MissingItemsLimit = _
xlMissingItemsNone
With Sheets("Comparison").PivotTables("PivotTable1").PivotFields("TASK/TB")
.PivotItems("(blank)").Visible = False
End With
With Sheets("Comparison").PivotTables("PivotTable2").PivotFields("TASK/TB")
.PivotItems("(blank)").Visible = False
End With
Dim bottomrow As Long
Sheets("Comparison").Select
bottomrow = Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
Range("D4:J4").AutoFill Destination:=Range("D4:J" & bottomrow), Type:=xlFillDefault
Application.ScreenUpdating = True
Call sourceSheet.Activate
End Sub
I'm not sure if just opening wb2 is introducing the REF errors or the insertion of the sheets.
E.g.
If you open workbook1, which has a formula which contains a reference to workbook2, and workbook2 is then opened in Protected Mode (per default settings), Excel will introduce REF errors in any cells with references to workbook2 (due to Protected mode).
If the above is your problem, then one way might be to add wb2 as trusted document or location, or Excel>File>Options>And turn off protected mode (inadvisable).
Irrespective of the above, other solution is you using:
Range.Find and loop through all cells with references to the
sheet(s) that will be inserted
Temporarily replace the first '=' with ' =' in these cells, which should turn the formula into a string value.
You then insert the sheets you want (string values can't experience REF errors)
Then replace ' =' with '=' to convert string back to Excel formula.
You could set a range object in step 1 that could then be reused in step 2 and 3.

How to export multiple selected worksheets to another workbook using VBA

I have a source excel file which contains worksheets starting with "TYPICAL" name.
I also have a code to export the "TYPICAL" worksheet to another Excel file using the Getopenfile name. As a part of code, I have to rename the source worksheet as value contained in cell "E3" and current date.
Attached code works fine for me, but I can not select multiple "TYPICAL" sheets and export. Can any one suggest a way to loop through the selected work sheets?
Sub export()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sht As Worksheet
Dim dt As String
Dim mntg As String
Set wb1 = ActiveWorkbook
Set Sht = Selection.Worksheet
Dim shtname As String
'
shtname = CStr(Sht.Name)
dt = CStr(Format(Date, "DDMMYY"))
If Left(shtname, 7) = "TYPICAL" Then
mntg = CStr(Range("E2").Value)
Sht.Name = mntg & "_" & dt
FileToOpen = Application.GetOpenFilename _
(Title:="choose a Excel file to insert selected Typical File", _
FileFilter:="*.xlsx (*.xlsx),")
'
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Sht.Name = shtname
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
End If
wb1.Activate
Sht.Copy After:=wb2.Sheets(wb2.Sheets.Count)
wb2.Save
wb2.Close
Else
MsgBox "This is not a Typical File for Export", vbExclamation, "ERROR"
End If
Sht.Name = shtname
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

How to paste a worksheet copied from another workbook into an existing worksheet?

I have found a little difficult to achieve copying an existing worksheet from a workbook, let's called it, "WB_RAW" and pasting it into an existing worksheet in another workbook. So far I have the next code, which I get from another post's answer. This code copies succesfully the worksheet but it creates a new worksheet in the workbook, let's called it, "Final_WB" instead of pasting the info into an existing workbook.
Sub ImportSheet()
Dim sImportFile As String, sFile As String
Dim sThisBk As Workbook
Dim vfilename As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisBk = ActiveWorkbook
sImportFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook")
If sImportFile = "False" Then
MsgBox "No File Selected!"
Exit Sub
Else
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open Filename:=sImportFile
Set wbBk = Workbooks(sFile)
With wbBk
If SheetExists("MTM Datos") Then
Set wsSht = .Sheets("MTM Datos")
wsSht.Copy before:=sThisBk.Sheets("B012")
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
Else
MsgBox "There is no sheet with name :MTM Datos in:" & vbCr & .Name
End If
wbBk.Close SaveChanges:=False
End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
End Function
Please help me, it's been a while since I used VBA for the last time so I do not remembe well how to use it
In this line you copy a full sheet with data
wsSht.Copy before:=sThisBk.Sheets("Bimbo12")
Change it to
wsSht.Cells.Copy sThisBk.Sheets("Bimbo12").Cells(1,1)
Application.CutCopyMode=False

VBA to Open Excel File and Paste Sheet 1 Data into “Main” Sheet in Current Workbook

Ok so I have a current workbook (Original Workbook) with one Sheet.
I would like to open an existing workbook (Data Workbook) and copy all of the contents in Sheet 1 of 'Data Workbook', then paste everything into Sheet "Main" of 'Original Workbook'.
At the end of this process I would like to close the 'Data Workbook' So far I have the following code.
however it gives me an error message
"Run-time error'1004': Cannot paste that macro formula onto a worksheet":
Sub ImportData()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range
Set wb1 = ActiveWorkbook
Set PasteStart = [Main!A1]
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
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
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
Hello please refer the code below and make changes according to your need. It does what you need.
Option Explicit
Sub import()
Dim filename As String
Dim curfilename As String
curfilename = ThisWorkbook.Name
filename = Application.GetOpenFilename
Application.ScreenUpdating = False
Dim x As Workbook
Set x = Workbooks.Open(filename)
With Sheets("1")
x.Sheets("1").Range("A1:Z10000").Copy '/Provide the range
End With
Dim y As Workbook
Set y = Workbooks(curfilename)
With Sheets("Main")
y.Sheets("Main").Range("A1").PasteSpecial xlPasteFormats
Application.DisplayAlerts = False
End With
x.Close SaveChanges:=False
Range("A1").Select
End Sub

MS EXCEL VBA - I need to import a worksheet from one excel file to another

I need to import a worksheet from one excel workbook (worksheet name is not always the same) and import it into the current active workbook.
Here is what I have so far:
Sub openFile_Click()
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.rpt (*.rpt),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Workbooks.Open Filename:=FileToOpen
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = ActiveWorkbook
wb2 = Workbooks(FileToOpen) 'This is where I am stuck..I can't give it a static name
For Each Sheet In wb1.Sheets
If Sheets.Visible = True Then
Sheets.Copy After:=wb2.Sheets(wb2.Sheets.Count)
End If
Next Sheet
End If
This code will work for what you want you want. I made the following corrections.
Move all declarations of variables to beginning of procedure so they are declared before you use them. It is just good practice.
Assign your Active Workbook to the variable before you open the second workbook so there is only one workbook open.
Your for each statement had a few corrections as well.
Sub openFile_Click()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = ActiveWorkbook
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.rpt (*.rpt),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
For Each Sheet In wb2.Sheets
If Sheet.Visible = True Then
Sheet.Copy After:=wb1.Sheets(wb1.Sheets.Count)
End If
Next Sheet
End If
End Sub
Set the Workbook on open, (or set the workbook later without the filepath)
Here you go:
Sub openFile_Click()
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.rpt (*.rpt),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open(FileToOpen)
For Each Sheet In wb1.Sheets
If Sheet.Visible = True Then
Sheets.Copy After:=wb2.Sheets(wb2.Sheets.Count)
End If
Next Sheet
End If
End Sub