I'm having trouble modifying this code to copy the first worksheet of a closed workbook and import it to the active workbook. It wants to copy all worksheets and it adds "after:=WB.Sheets(WB.Sheets.Count)" to a random cell in the sheet.
Any help is greatly appreciated.
Dim WB As Workbook
Dim SourceWB As Workbook
Dim WS As Worksheet
Dim ASheet As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False
Set WB = ActiveWorkbook
Set ASheet = ActiveSheet
Set SourceWB = Workbooks.Open("C:\Users\ME\Desktop\Book1.xlsx")
For Each WS In SourceWB.Worksheets
WS.Copy after:=WB.Sheets(WB.Sheets.Count)
Next WS
SourceWB.Close savechanges:=False
Set WS = Nothing
Set SourceWB = Nothing
WB.Activate
ASheet.Select
Set ASheet = Nothing
Set WB = Nothing
Application.EnableEvents = True
Try this:
Option Explicit
Public Sub copyFirstWS()
Dim wb As Workbook
Set wb = Workbooks.Open("C:\Users\ME\Desktop\Book1.xlsx")
With ThisWorkbook
wb.Worksheets(1).Copy After:=.Worksheets(.Worksheets.Count)
End With
wb.Close savechanges:=False
End Sub
Related
I'm trying to copy all worksheets from a file saved on a network drive into my current active workbook. After they are copied I would like to hide them.
The tricky part, which I have yet to been able to find, is every time the macro is re-run I would like those worksheets that were previously copied over to be overwritten or deleted and replaced by the new worksheets from the existing file I am copying from.
Currently, I have my code set up to just copy over a specific worksheet depending on the string of a hyperlink. Below is what I've started but its not quite the direction I want to head.
Note the below is the edited script:
Sub ImportWorksheets()
Dim wb As Workbook, ws As Worksheet, wbTarget As Workbook, wsTarget As Worksheet
Application.ScreenUpdating = False
Dim pth As String
pth = wb.Path
Dim titleDetailPth As String
titleDetailPth = Left(pth, InStrRev(pth, "\") - 1)
Dim filePthName As String
filePthName = titleDetailPth & "\New Release Templates\" & "Key New Release Accounts Details.xlsx"
Set wb = ActiveWorkbook 'Your workbook
Set wbTarget = Workbooks.Open(filePthName, UpdateLinks:=False, ReadOnly:=True) 'The drive workbook
For Each wsTarget In wbTarget.Worksheets 'a loop for each worksheet on the drive workbook
For Each ws In wb.Worksheets ' a loop for each worksheet on your workbook
If wsTarget.Name = ws.Name Then 'if the sheet you are trying to import exist, it will delete it
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
wsTarget.Copy After:=wb.Sheets(wb.Sheets.Count) 'this will copy it into the last sheet
wb.Sheets(wb.Sheets.Count).Visible = 0 'this will hide it
Next wsTarget
wbTarget.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub
Then this should do the work for you:
Sub ImportWorksheets()
Dim wb As Workbook, ws As Worksheet, wbTarget As Workbook, wsTarget As Worksheet
Application.ScreenUpdating = False
Set wb = ThisWorkbook 'Your workbook
Set wbTarget = Workbooks.Open("wherever your drive file is", UpdateLinks:=False, ReadOnly:=True) 'The drive workbook
For Each wsTarget In wbTarget.Worksheets 'a loop for each worksheet on the drive workbook
For Each ws In wb.Worksheets ' a loop for each worksheet on your workbook
If wsTarget.Name = ws.Name Then 'if the sheet you are trying to import exist, it will delete it
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
wsTarget.Copy After:=wb.Sheets(wb.Sheets.Count) 'this will copy it into the last sheet
wb.Sheets(wb.Sheets.Count).Visible = 0 'this will hide it
Next wsTarget
wbTarget.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub
I have invoice with lots of Data. I want to Export and import data. I have created Export VBA that exports particular sheet ("Invoice Data"). I have saved it somewhere. Now I need to import that same file into active worksheet.
I have this code
Dim WB As Workbook
Dim SourceWB As Workbook
Dim WS As Worksheet
Dim ASheet As Worksheet
'Turns off screenupdating and events:
Application.ScreenUpdating = False
Application.EnableEvents = False
'Sets the variables:
Set WB = ActiveWorkbook
Set ASheet = ActiveSheet
Set SourceWB = Workbooks.Open(WB.Path & "\1.xlsx") 'Modify to match
'Copies each sheet of the SourceWB to the end of original wb:
For Each WS In SourceWB.Worksheets
WS.Copy after:=WB.Sheets(WB.Sheets.Count)
Next WS
SourceWB.Close savechanges:=False
Set WS = Nothing
Set SourceWB = Nothing
WB.Activate
ASheet.Select
Set ASheet = Nothing
Set WB = Nothing
Application.EnableEvents = True
this code works pretty well. but i want to choose the file with file open dialog
Anyone help me please
Finally found the code....
Dim wbk1 As Workbook, wbk2 As Workbook
fileStr = Application.GetOpenFilename()
Set wbk1 = ActiveWorkbook
Set wbk2 = Workbooks.Add(fileStr)
wbk2.Sheets("invoice data").Copy After:=wbk1.Sheets(1)
thank you guys
if your question is about.. how to use File open dialog.. you can use this code
NewWorkbook = Application.GetOpenFilename( _
FileFilter:="Excel 2003 (*.xls),*.xls,Excel 2007 (*.xlsx),*.xlsx,Excel 2007 (*.xlsm),*.xlsm", _
Title:="Select an Excel File", _
MultiSelect:=File)
If NewWorkbook = False Then
Exit Sub
Else
Workbooks.Open Filename:=NewWorkbook
End If
You can remove filters if you want to select any kind of files
I am running a code that aims to pull in data from all workbooks within a specific folder. I have written the code for the loop separate from the code for the pulling in of data.
Sub FixedIncomeLoop()
Dim file As Variant
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim folderpath As String
Dim ws As Worksheet
Dim ws2 As Worksheet
Set wb1 = ActiveWorkbook
Set ws = ActiveSheet
folderpath = "C:\Users\Wei Hong\Documents\Trade Tickets\"
file = Dir(folderpath)
While (file <> "")
Set wb2 = Workbooks.Open(file)
Set ws2 = wb2.Worksheets("Trade Ticket")
Call FixedIncome(wb1, ws, ws2)
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Wend
End Sub
Private Sub FixedIncome(wb1 As Workbook, ws As Worksheet, ws2 As Worksheet)
Dim ws3 As Worksheet
Set ws3 = wb1.Worksheets("Constants") <-- facing error
ws.Activate
...
End Sub
I am facing the runtime error above. Not sure why!
Hello I'm trying to copy columns C, R, W,X from file 1 to file 2 with below code but keep getting an error. My VBA knowledge isn't that good yet but probably has to do with the range setting? I've tried multiple ways but can't get it to work.
Am I using the right setting or should I use another action to get the specific columns?
Sub PFS()
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim rngCopy As Range
Dim wbPaste As Workbook
Dim wsPaste As Worksheet
Dim rngPaste As Range
Set wbPaste = ActiveWorkbook
Set wbCopy = Workbooks.Open("path to copy")
Set wsCopy = wbCopy.Worksheets("Blad1")
Set rngCopy = wsCopy.Range("d, e").EntireColumn
Set wsPaste = wbPaste.Worksheets("PFS")
Set rngPaste = wsPaste.Range("a1")
rngCopy.Copy
rngPaste.PasteSpecial
Workbooks.Application.CutCopyMode = False
Application.DisplayAlerts = False
wbCopy.Save
wbCopy.Close
End Sub
Solutions to copy entire column.
Sub copy()
Dim wb As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim wsNew As Worksheet
Set wb = ActiveWorkbook
Set ws = wb.Sheets("old")
Set wbNew = Workbooks("Book.xlsx")
Set wsNew = wbNew.Sheets("new")
ws.Columns(3).copy
wsNew.Columns(3).Insert Shift:=xlToRight
ws.Columns(18).copy
wsNew.Columns(18).Insert Shift:=xlToRight
ws.Columns(23).copy
wsNew.Columns(23).Insert Shift:=xlToRight
ws.Columns(24).copy
wsNew.Columns(24).Insert Shift:=xlToRight
Set wsNew = Nothing
Set wbNew = Nothing
Set ws = Nothing
Set wb = Nothing
End Sub
i two workbooks . I need to copy pagesetup from wb2 to wb1 . .
With wb1.sheets("test")
.pagesetup.footermargin = wb2.sheets("xxx").pagesetup.footermargi
End
Try this:
Sub savefooter()
Dim twb as workbook
Dim wb2 as workbook
Dim a as variant
Application.DisplayAlerts = False
Set twb = ThisWorkbook
a = twb.Sheets("Sheet1").PageSetup.FooterMargin
Set wb2 = Workbooks.Open("C:\b.xlsx") ' set path to where your second wb is
wb2.Sheets("Sheet1").PageSetup.FooterMargin = a
wb2.Save
wb2.Close
Application.DisplayAlerts = True
End Sub