I very recently got into VBA coding, however, even though the code compiles without any hiccups, it still fails to do it's intended purpose.
Essentially, this is merely a test program created to copy and paste information from one workbook to another in a specific cell.
Sub CopyOpenItems()
' CopyOpenItems Macro
' Copy open items to sheet.
' Keyboard Shortcut: Ctrl+Shift+O
'
Dim wbTarget As Workbook 'workbook where the data is to be pasted
Dim wbThis As Workbook 'workbook from where the data is to copied
Dim wsTarget As Worksheet
Dim wsThis As Worksheet
Dim strName As String 'name of the source sheet/ target workbook
'set to the current active workbook (the source book)
Set wbThis = ActiveWorkbook
'get the active sheetname of the book
strName = ActiveSheet.Name
'open target workbook
Set wbTarget = Workbooks.Open("C:\Users\Administrator\Desktop\Excel Testing\Excel Info Testing 2.xlsx")
'set variable to current worksheet
Set wsThis = ActiveSheet
'set variable to target worksheet
Set wsTarget = wbTarget.Worksheets(strName)
wsThis.Range("C6").Select
'clear any thing on clipboard to maximize available memory
Application.CutCopyMode = False
'copy the range from source book
wsThis.Range("C6").Copy
'paste the data on the target book
wsTarget.Range("E5").PasteSpecial
'clear any thing on clipboard to maximize available memory
Application.CutCopyMode = False
'save the target book
wbTarget.Save
'close the workbook
wbTarget.Close
'clear memory
Set wbTarget = Nothing
Set wbThis = Nothing
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'm currently using code that I found a few years ago to copy one worksheet to a new workbook, but it uses cells.copy which removes some important formatting. I'd like to use sheets.copy instead but the sheet names are constantly changing and I'm not sure how to code that. Thanks for your help. Here is the code I'm currently using:
Sub SheetsToFiles()
'Takes a sheet from a workbook and turns it into a file named after the
sheet name
Dim mySourceWB As Workbook
Dim mySourceSheet As Worksheet
Dim myDestWB As Workbook
Dim myNewFileName As String
' First capture current workbook and worksheet
Set mySourceWB = ActiveWorkbook
Set mySourceSheet = ActiveSheet
' Build new file name based
myNewFileName = mySourceWB.Path & "\" & mySourceSheet.Name & ".xlsx"
' Add new workbook and save with name of sheet from other file
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=myNewFileName
Set myDestWB = ActiveWorkbook
' Copy over sheet from previous file
mySourceWB.Activate
Cells.Copy
myDestWB.Activate
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.DisplayGridlines = False
' Resave new workbook
ActiveWorkbook.Save
' Close active workbook
ActiveWorkbook.Close
End Sub
I would use the Worksheet.copy method to copy the Worksheet to the new Workbook, this should preserve the formatting of the original sheet. Here's the code updated with comments:
Sub SheetsToFiles()
'Takes a sheet from a workbook and turns it into a file named after the Sheet Name
Dim mySourceWB As Workbook
Dim mySourceSheet As Worksheet
Dim myDestWB As Workbook
Dim myNewFileName As String
' First capture current workbook and worksheet
Set mySourceWB = ActiveWorkbook
Set mySourceSheet = ActiveSheet
' Build new file name based
myNewFileName = mySourceWB.Path & "\" & mySourceSheet.Name & ".xlsx"
' Create a new Workbook with one blank Worksheet (this will be deleted later)
Set myDestWB = Workbooks.Add(xlWBATWorksheet)
' Copy sheet to DestWB and paste after the first Worksheet
mySourceSheet.Copy After:=myDestWB.Worksheets(1)
' Delete the unused Worksheet, turn off alerts to bypass the confirmation box
Application.DisplayAlerts = False
myDestWB.Worksheets(1).Delete
Application.DisplayAlerts = True
' Save with name of sheet from other file
myDestWB.SaveAs Filename:=myNewFileName
' Close Destination workbook
myDestWB.Close
End Sub
Try this code ,
Sub SheetsToFiles()
'Takes a sheet from a workbook and turns it into a file named after the
Dim mySourceWB As Workbook
Dim mySourceSheet As Worksheet
Dim myDestWB As Workbook
Dim myNewFileName As String
' First capture current workbook and worksheet
Set mySourceWB = ActiveWorkbook
Set mySourceSheet = ActiveSheet
' Build new file name based
myNewFileName = mySourceWB.Path & "\" & mySourceSheet.Name & ".xlsx"
' Add new workbook and save with name of sheet from other file
Workbooks.Add
Set myDestWB = ActiveWorkbook
myDestWB.SaveAs Filename:=myNewFileName
' Copy over sheet from previous file
mySourceSheet.Range("A1:Z100").Copy Destination:=myDestWB.Sheets("Sheet1").Range("A1:Z100")
ActiveWindow.DisplayGridlines = False
' Resave new workbook
ActiveWorkbook.Save
' Close active workbook
ActiveWorkbook.Close
End Sub
I have a number of scripts that are in a module in my Personal.xlsb file. It's kept hidden, but in this script, the idea is that you run it from within a different workbook each time. It opens a separate workbook (source.xlsx), copies a range from it, pastes into the original workbook, and then closes source.xlsx.
When it comes to the "ThisWorkbook.ActiveSheet.Paste" part, it's pasting it into the Personal.xlsb workbook instead of the target workbook that is actually open and visible. How can I make sure it's being pasted in the right workbook? The workbook's filename will always be different, so I can't specify a path or anything like that.
Sub CopyData()
Application.DisplayAlerts = False
Dim wbSource As Workbook
Set wbSource = Workbooks.Open(Filename:="source.xlsx", UpdateLinks:=3)
wbSource.Sheets(1).Range("A1:X105").Copy
ThisWorkbook.ActiveSheet.Paste
wbSource.Close
Application.DisplayAlerts = True
Call CopyCFormat
End Sub
Don't use ThisWorkbook in most cases, as it references the workbook that the macro is stored in (in this case, personal.xlsb).
Instead, you can use ActiveWorkbook to refer to whichever workbook has focus at the time the macro is run. You can also assign ActiveWorkbook to a variable for easier reference.
Sub CopyData()
Application.DisplayAlerts = False
Dim wbSource As Workbook
Dim wbTarget as Workbook
Set wbTarget = ActiveWorkbook
Set wbSource = Workbooks.Open(Filename:="source.xlsx", UpdateLinks:=3)
wbSource.Sheets(1).Range("A1:X105").Copy
wbTarget.ActiveSheet.Paste
wbSource.Close
Application.DisplayAlerts = True
Call CopyCFormat
End Sub
You could also reference the active sheet without specifying which workbook it's in, as:
Dim wbSource As Workbook
Dim shtTarget as Worksheet
Set shtTarget = ActiveSheet
Set wbSource = Workbooks.Open(Filename:="source.xlsx", UpdateLinks:=3)
wbSource.Sheets(1).Range("A1:X105").Copy
shtTarget.ActiveSheet.Paste
Luck!
If I understand it, you should just add another workbook variable.
Sub CopyData()
Dim mainWB As Workbook
Dim mainWS As Worksheet
Set mainWB = ActiveWorkbook
Set mainWS = mainWB.Sheets(1) ' Change this to whatever you need it to be
Application.DisplayAlerts = False
Dim wbSource As Workbook
Set wbSource = Workbooks.Open(Filename:="source.xlsx", UpdateLinks:=3)
wbSource.Sheets(1).Range("A1:X105").Copy
mainWS.Paste
wbSource.Close
Application.DisplayAlerts = True
Call CopyCFormat
End Sub
can someone please tell me why the data is not copying and pasting (or why it is copying and pasting blank data? Also is there a way to speed the automation?
Sub GetDataCopyPaste()
Dim wbTarget As Workbook 'where the data will be pasted
Dim wbSource As Workbook 'where the data will be copied
Dim StrName As String 'name of the source sheet
Application.ScreenUpdating = False 'these statements help performance by disabling the self titled in each, remeber to re-enable at end of code
Application.DisplayAlerts = False
Set wbTarget = ActiveWorkbook 'set to the current workbook
StrName = ActiveSheet.Name 'get active sheetname of workbook
Set wbSource = Workbooks.Open("C:\Users\jjordan\Desktop\Test Dir\Test File Test\metrics list.xlsx") 'opens Target workbook
Set wbTarget = Workbooks.Open("C:\Users\jjordan\Desktop\Test Dir\MASTER\Weekly Logbook - 2016.xlsm") 'opens Source workbook
wbSource.Sheets("IOS").Range("A1:E60").Value = wbTarget.Sheets("Sheet6").Range("A1:E60").Value 'copy & pastes source data onto Target workbook
wbTarget.Save 'save workbook
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
This line is backwards
wbSource.Sheets("IOS").Range("A1:E60").Value = wbTarget.Sheets("Sheet6").Range("A1:E60").Value 'copy & pastes source data onto Target workbook
You need
wbTarget.Sheets("Sheet6").Range("A1:E60") = wbSource.Sheets("IOS").Range("A1:E60").value
I just tested and succeeded
Option Explicit
Sub test()
Dim myWB As Workbook
Set myWB = Workbooks.Open("C:\Users\raystafarian\Downloads\Book3.xlsx")
Dim yourWB As Workbook
Set yourWB = Workbooks.Open("C:\Users\raystafarian\Downloads\Book2.xlsm")
myWB.Sheets("Sheet1").Range("C1:C4").Value = yourWB.Sheets("Sheet1").Range("A1:A4").Value
End Sub
I'm trying to create a form based interface using the VBA. I ran into a problem which I cannot figure it out. So in my code, I try to create a new workbook then save it. After that it will scan through the checkbox and see which one is getting selected. If it get selected, it will create a new sheet and copy the pre-made template. The user will open another workbook that they want and it will copy the information from that workbook to the workbook that just made. Here is the code for retrieving the data:
Sub mil10_data()
Dim NewWB As Workbook
Dim thisWB As Workbook
Dim wb As Workbook
Dim Ret
Set thisWB = ThisWorkbook
Set NewWB = ActiveWorkbook
With NewWB
'Copy the pre-made template to new workbook
thisWB.Sheets("Data 10").Range("A1:AZ3000").Copy NewWB.Sheets(ActiveSheet.Name).Range("A1:AZ3000")
'Retriving the data
Ret = Application.GetOpenFilename("Excel Files (*.CSV), *.CSV", Title:="Select File To Be Opened")
If Ret = False Then Exit Sub
Set wb = Workbooks.Open(Ret)
**'This is where the error is show up
wb.Sheets(ActiveSheet.Name).Range("E21:E2136").Copy NewWB.Sheets(ActiveSheet.Name).Range("C2:C2117")**
wb.Close SaveChanges:=False
Set wb = Nothing
Set NewWB = Nothing
End With
End Sub
I figure that maybe because there are three workbooks open, it didn't know which one is the active workbook, but that is not the case. I tested by using the MsgBox and it display the right workbook and worksheeet name that I want. If I change the ActiveSheet.Name to the actual sheet name, it works, but I don't want to use that method. I have different worksheets that need to be created, so I prefer using the ActiveSheet.Name. Anyone know why it didn't work? I would really appreciate the help. Thank you!
ActiveWorkbook and ActiveSheet are really clumsy ways of getting user input. You should save in variables the properties that are you interested in (as soon as possible), and then stop referring them directly.
In your case, the code may look like
Sub mil10_data()
Dim NewWB As Workbook
Dim thisWB As Workbook
Dim wb As Workbook
Dim Ret
Dim active_sheet_name As String
Set thisWB = ThisWorkbook
Set NewWB = ActiveWorkbook
Let active_sheet_name = Application.ActiveSheet.Name
With NewWB
'Copy the pre-made template to new workbook
thisWB.Sheets("Data 10").Range("A1:AZ3000").Copy NewWB.Sheets(active_sheet_name).Range("A1:AZ3000")
'Retrieving the data
Ret = Application.GetOpenFilename("Excel Files (*.CSV), *.CSV", Title:="Select File To Be Opened")
If Ret = False Then Exit Sub
Set wb = Workbooks.Open(Ret)
wb.Sheets(active_sheet_name).Range("E21:E2136").Copy NewWB.Sheets(active_sheet_name).Range("C2:C2117")
wb.Close SaveChanges:=False
Set wb = Nothing
Set NewWB = Nothing
End With
End Sub
If you still get "Subscript out of range" error, that means that you either don't select correctly the ActiveSheet before running the script, or that sheet does not exist in the workbook wb.