I want to ask about loop in VBA. I have this VBA code:
Sub OpenCopyPaste()
' open the source workbook and select the source sheet
Workbooks.Open Filename:="C:\Users\Adryan Permana\Downloads\Test\part8.xlsx"
Sheets("Sheet1").Select
' copy the source range
Sheets("Sheet1").Range("C2:E2,C3:E3,C4:E4,C5:E5,C6:E6,C7:E7,C8:E8,C9:E9").Select
Selection.Copy
' select current workbook and paste the values starting at A1
Windows("report.xlsx").Activate
Sheets("Sheet1").Select
Sheets("Sheet1").Range("C3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
End Sub
I want to select all data in range "C2:E2" to "C9:E9" and paste it to other workbook.
In my current code, I need to type one by one range from C2 - C9.
I want to select data from C2-C9 in loop.
Is there any way to do it in loop?
You can copy the entire range with Range("C2:E9").Copy.
Also, there is no need to use Select, Activate and Selection, it slows down the code run-time, just use fully qulifed Wroksheets and Range instead.
Code
Option Explicit
Sub OpenCopyPaste()
Dim wb As Workbook
Dim Reportwb As Workbook
' set report workbook to workbook object (works only is the file is already open)
Set Reportwb = Workbooks("report.xlsx")
' open the source workbook and select the source sheet
Set wb = Workbooks.Open(Filename:="C:\Users\Adryan Permana\Downloads\Test\part8.xlsx")
' copy the source range and paste in 1 line , paste at "C3"
wb.Sheets("Sheet1").Range("C2:E9").Copy Destination:=Reportwb.Sheets("Sheet1").Range("C3")
Application.CutCopyMode = False
Reportwb.Save
End Sub
Instead use C2:E9
Sub OpenCopyPaste()
' open the source workbook and select the source sheet
Workbooks.Open Filename:="C:\Users\Adryan Permana\Downloads\Test\part8.xlsx"
Sheets("Sheet1").Select
' copy the source range
Sheets("Sheet1").Range("C2:E9").Select
Selection.Copy
' select current workbook and paste the values starting at A1
Windows("report.xlsx").Activate
Sheets("Sheet1").Select
Sheets("Sheet1").Range("C3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
End Sub
Related
I'm stuck, I am trying to write the macro, we have 2 files;
ORG - empty file that I am running the macro from
NOT_ORG - sheets with some data
I want to loop through sheets in NOT_Org, check if this sheet name is in array, if so, create a new sheet in ORG file, paste the value from NOT_ORG, and loop over next sheets from NOT_ORG to check the same. Below code I wrote so far, I am getting confused how to comfortable switch between Workbooks, as I am getting errors - either when I am setting WB2 and second issue is within For each loop. Could someone point me to the right direction, how to switch between these workbooks within this for each loop?
Sub Test1()
Dim WshtNames As Variant
Dim WshtNameCrnt As Variant
Dim ws As Worksheet
Dim os As Worksheet
Dim x As String
Dim WB1 As Workbook
Dim WB2 As Workbook
Set WB1 = ActiveWorkbook
Set WB2 = Workbooks.Open("C:\NOT_ORG.xlsx")
' loop through sheets in file that i just open (wb2), check if sheet name is in array below,
' copy A1 value & assign to a variable sheet name that i am copying from, with new prefix
' _new / open "org file" - that I am running macro from - create a new sheet and assign this
' sheet name, paste the value. And do the same for each sheet if this sheet name is in list.
'
WshtNames = Array("2", "3")
For Each WshtNameCrnt In WshtNames
With Worksheets(WshtNameCrnt).Activate
Range("A1").Select
Selection.Copy
Sheets.Add.Name = WshtNameCrnt & "_new"
' -> S
'x = ActiveSheet.Name
'#MsgBox (x)
ActiveSheet.Paste
End With
Next WshtNameCrnt
End Sub
Thanks
eM
Please, replace:
For Each WshtNameCrnt In WshtNames
With Worksheets(WshtNameCrnt).Activate
Range("A1").Select
Selection.Copy
Sheets.Add.Name = WshtNameCrnt & "_new"
' -> S
'x = ActiveSheet.Name
'#MsgBox (x)
ActiveSheet.Paste
End With
Next WshtNameCrnt
with:
For Each WshtNameCrnt In WshtNames
WB1.Sheets.Add.Name = WshtNameCrnt & "_new"
WB2.Worksheets(WshtNameCrnt).Range("A1").Copy ActiveSheet.Range("A1")
Next WshtNameCrnt
In order to work, two sheets named as "1" and "2" (not their index) should exist in WB2.
Activating, selecting only consumes Excel resources, making the code slower and not bringing any benefit...
I'm trying to copy cell values from one excel to another using VBA. What I'm trying to do is that by clicking on the script, excel (without getting opened) values should automatically get copied from one worksheet to another. While executing my script I get an error which says Type Mismatch: 'Sheets'. I've read various posts but could not find an answer to this problem. My script looks like this:
ImportData_Click
Sub ImportData_Click()
Dim objExcel2
Set objExcel2 = CreateObject("Excel.Application")
' open the source workbook and select the source sheet
objExcel2.Workbooks.Open "<path>\test1_vbs.xlsx"
' copy the source range
Sheets("Sheet1").Range("A1:B2").Copy
' select current workbook and paste the values
ThisWorkbook.Activate
Sheets("Sheet2").Range("A1:B2").PasteSpecial xlPasteValues
' close the source workbook
Windows("<path>\test1_vbs.xlsx").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
If you are going to tranfer values only between application instances, skip the clipboard and use an array.
Option Explicit
Sub ImportData_Click()
Dim objExcel2 As Object, arr As Variant
Set objExcel2 = CreateObject("Excel.Application")
' open the source workbook and select the source sheet
With objExcel2.Workbooks.Open("c:\test\test2_vbs.xlsx")
' copy the source range to variant array
arr = .Worksheets("Sheet1").Range("A1:B2").Value
' close the source workbook
.Close savechanges:=False
End With
' select current workbook and paste the values
ThisWorkbook.Worksheets("Sheet2").Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
' close the source application instance
objExcel2.Quit
Set objExcel2 = Nothing
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
I'm trying to automatically copy a set of data based on todays date.
What I want to do is, have the workbook (already open) which i want to copy data, change the date, and it automatically copies the data from a file I get emailed.
Right now I can do that, but now I want to only copy data if Column P is the same value as Cell AV1 (which is also the date) in my original workbook. I've tweaked my code, but it no longer works and I get
RUNTIME ERROR 9 subscript out of range
Any ideas would be greatly appreciated.
Sub import()
Dim wb1 As Workbook, wb2 As Workbook
Dim rangedate As Range
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("Location of file\.csv")
Set rangedate = wb2.Sheets(1).Range("P2:P1000")
For Each cell In rangedate
If cell.Value = Workbooks("Original workbook.xlsm").Range("AV1") Then
ActiveCell.EntireRow.Copy
wb.Range("A").PasteSpecial Paste:=xlValues
End If
Next
Application.CutCopyMode = False
wb2.Close SaveChanges:=False
End Sub
I need to loop through 47 different worksheets in a single workbook.
The macro being run on each worksheet is creating a new individual workbook for that worksheet. My challenge is that once the worksheet from the original workbook is converted into a new workbook my macro now starts looping through the worksheet on the new workbook instead of the original. I have been trying to figure out some sort of code that counts each worksheet on the original workbook and then loops back to the original once the new workbook is created.
Sub PriceListWest()
'
' PriceListWest Macro
'
Dim Current As Worksheet
Windows("West price list master.xlsm").Activate 'Original workbook'
For Each Current In Worksheets
ActiveSheet.Select 'Selecting worksheet in original workbook'
ActiveSheet.Copy 'Copying worksheet in original workbook'
'Challenge lies here now the loop goes through the new workbook versus returning to original workbook'
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.EntireColumn.Hidden = False
Next
End Sub
It is a bad habit to use Select and Activate unless you keep track of exactly which sheet / cell is active from time to time. Refer to How to avoid using Select for tips on ways to avoid those commands.
Assuming your existing code successfully processed the first worksheet, when it started to process the second worksheet the ActiveSheet was still the recently created copy of the first worksheet. So that sheet would then be copied to another workbook, rather than copying one of the worksheets from your original workbook.
The following code uses a reference to the original workbook, and a reference to the Current object which your code already creates, to ensure that the correct sheets are being referenced:
Sub PriceListWest()
'
' PriceListWest Macro
'
Dim wbMaster As Workbook
Dim Current As Worksheet
'Set a reference to the original workbook
Set wbMaster = Workbooks("West price list master.xlsm")
'Loop through each sheet in original workbook
For Each Current In wbMaster.Worksheets
'Copy the "current" sheet to a new workbook
Current.Copy
'The "Copy" command has now made the new workbook active, and
' "ActiveSheet" is the newly created sheet in that workbook
With ActiveSheet
'Copy entire sheet
.Cells.Copy
'Paste values
.Cells.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
'Unhide all columns
.Columns.Hidden = False
'Set "active" cell to A1, just so the whole sheet isn't selected
.Cells(1, 1).Select
End With
Next
Application.CutCopyMode = False
End Sub
The code does continue to use ActiveSheet but only in a spot where we know that the active sheet is the newly copied sheet in the newly created workbook.
your main error lies on the fact that your Current variable holds the current worksheet while iterating through Worksheets collection, while ActiveSheetis the currently "Active" sheet and doesn't change until you Activate a new sheet (and looping doesn't Activate)
and after every ActiveSheet.Copy, the newly created workbook becomes the ActiveWorkbook and its only sheet the ActiveSheet
so you have to use Current instead of ActiveSheet
furthermore acting on all the Cells of a worksheet is time consuming and may rise memory issues: much better you refer to UsedRange property of Worksheet object
so you could code:
Option Explicit
Sub PriceListWest()
'
' PriceListWest Macro
'
Dim Current As Worksheet
For Each Current In Workbooks("West price list master").Worksheets
Current.Copy '<--| copy current worksheet from 'original' workbook into a new workbook, this latter becomes the "active" workbook and it's only sheet the "Active" Sheet
With ActiveSheet.UsedRange '<--| reference "Active" worksheet of current "Active" Workbook
.value = .value
.EntireColumn.Hidden = False
End With
Next
End Sub
Finally, acting like above will leave you with as many open workbooks as pasted sheets, while you may want to save and close them at every iteration, thus leaving you with the 'original' workbook only:
Option Explicit
Sub PriceListWest()
'
' PriceListWest Macro
'
Dim Current As Worksheet
For Each Current In Workbooks("West price list master").Worksheets
Current.Copy '<--| copy current worksheet from 'original' workbook into a new workbook, this latter becomes the "active" workbook and it's only sheet the "Active" Sheet
With ActiveSheet.UsedRange '<--| reference "Active" worksheet of current "Active" Workbook
.value = .value
.EntireColumn.Hidden = False
End With
ActiveWorkbook.SaveAs filepathandname '<-- save current workbook
ActiveWorkbook.Close '<--| close it
Next
End Sub
I recorded this macro:
Sheets("Sheet1").Select
Range("D4:E4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ALB3").Select
Range("C1").Select
ActiveSheet.Paste
I want to make a loop to repeat the process.
From range D4:E4 to D200:E200 when do select
To paste that on respective sheet name from ALB3 to ALB196.
My data in sheet 1.
Column a is sheets name, column d4 and e4, is the data that I want to paste on every sheet already created.
If you're trying to copy a range from one sheet to another, you don't need a loop and you don't need to select. You can use copy syntax that doesn't use your clipboard.
Try this:
Sub CopyRangeToAnotherSheet()
Dim source As Worksheet
Dim target As Worksheet
Set source = ActiveWorkbook.Sheets("Sheet1")
Set target = ActiveWorkbook.Sheets("Sheet2")
source.Range("D4:E200").Copy target.Range("ALB3")
End Sub
To copy the source range to all sheets in the workbook except the source worksheet, try this:
Sub CopyToAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
CopyRangeToAnotherSheet (ws.Name)
Next
End Sub
Sub CopyRangeToAnotherSheet(targetName As String)
Dim source As Worksheet
Dim target As Worksheet
Set source = ActiveWorkbook.Sheets("Sheet1")
Set target = ActiveWorkbook.Sheets(targetName)
If target.Name <> source.Name Then
source.Range("D4:E200").Copy target.Range("ALB3")
End If
End Sub