Here is my code:
Workbooks("A").Worksheets("Sheet1").Activate
Range("B2:BG2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.copy
Workbooks("C.xlsm").Worksheets("Sheet1").Activate
ActiveSheet.Paste
I am getting a Subscript Out of Range error at the first line.
Now error is at last line:
Workbooks("A.xlsm").Activate
Worksheets("Sheet1").Select
Range("B2:BG2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.copy
Workbooks("C.xlsm").Worksheets("Sheet1").Activate
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=45
lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & lMaxRows + 1).Select
Workbooks("AB.xlsm").Activate
Worksheets("Sheet1").Select
Range("B2:BG2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.copy
Workbooks("C.xlsm").Worksheets("Sheet1").Activate
ActiveSheet.Paste
Rather than syntax like:
Workbooks("A").Worksheets("Sheet1").Activate
use something like:
Workbooks("A.xlsm").Activate
Worksheets("Sheet1").Select
Try setting reference for workbook and worksheet first:
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim wb2 As Workbook
Dim ws2 As Worksheet
Set wb1 = Workbooks("Book1")
Set ws1 = wb1.Sheets(1)
Windows(2).Activate
Set wb2 = ActiveWorkbook
Set ws2 = wb2.Sheets(1)
ws1.Activate
ws1.Range("B2:BG2").Select
Selection.Copy
wb2.Activate
ws2.Activate
ActiveSheet.Paste
To answer your second question.
Try replacing :
Workbooks("C.xlsm").Worksheets("Sheet1").Activate
with :
Workbooks("C.xlsm").Activate
Worksheets("Sheet1").Activate
The reason behind this is: when you call it in one line, you only want to activate the worksheet within that workbook; rather than activating both the workbook and the worksheet.
Another reason that may be causing trouble in this case is if you do not have a valid region selected in your Workbooks("C.xlsm").Worksheets("Sheet1") when you try to copy into it. Try adding Cells(1,1).Select before pasting.
I'll end with a better alternative that does not require activating workbooks/worksheets :
The .Copy method has a "destination" parameter that may be set to be within any existing sheet of any open workbook. For example, you could replace the last 4 lines with something like :
Range(Selection, Selection.End(xlDown)).Copy _
(Workbooks("C.xlsm").Worksheets("Sheet1").Range("A1"))
Related
So I'm trying to format to all sheets apart from the "Names" sheet. and what I came up with below doesn't seem to be able to loop and detect the sheet "Names". It will try to format "Names" the said sheet is active or it will only apply format a single other sheets when the sheets is active
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Names" Then
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$Q$19").AutoFilter Field:=4, Criteria1:="="
Rows("2:2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A$1:$Q$16").AutoFilter Field:=4
Columns("G:G").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft
Range("J15").Select
End If
Next ws
I've tried rewriting the codes completely but the same problem persists
In addition to removing Activesheet, rewriting to avoid .select, and maybe considering an alternative to Criteria1:="=" (as already mentioned);
Consider using a With statement to definitely connect each action to the current sheet.
Sub Format_Worksheets()
Dim WS As Worksheet
Dim lRow As Long
Dim lCol As Long
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> "Names" Then
With WS
.Rows("1:1").AutoFilter
.Range("$A$1:$Q$19").AutoFilter Field:=4, Criteria1:="="
lRow = .Range("A2").End(xlDown).Row
lCol = .Range("A2").End(xlToRight).Column
.Range(.Cells(lRow, 1), .Cells(lRow, lCol)).Delete shift:=xlUp
.Range("$A$1:$Q$16").AutoFilter Field:=4
lCol = .Range("G1").End(xlToRight).Column
.Range("G1", .Cells(1, lCol)).Delete shift:=xlToLeft
End With
End If
Next WS
End Sub
Let me know if this works out for you. It did for me... but I'm not 100% sure the formatting will match what your did. I rewrote it without .select or .activate but sometimes it's hard to tell without looking at the data.
I have the following set of code to record daily employees who eat lunch in the canteen. What change is needed so that when the person clicks on the macro button every day, the data is on the 1st blank line (from column A) of the "dados_diarios" sheet?
This is so that at the end of the month I have a list of all the days.
Sub outros_diario()
Sheets("outros").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Workbooks.Open ("N:\RH\Cantina\Lista_OUTROS.xlsx")
Windows("Lista_OUTROS.xlsx").Activate
Cells.Select
Selection.Copy
Windows("outros.xlsm").Activate
Sheets("outros").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
ActiveWindow.DisplayGridlines = False
Range("B8:O1000").Select
Selection.Copy
Sheets("dados_diarios").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C2:F1000").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("E2:H1000").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Range("H8").Select
Columns("C:C").EntireColumn.AutoFit
End Sub
Give this a go. You may want to add back in your DisplayGridlines= False and the deletion of cells at the end - but it should give you a much better start than where you're up to right now:
Sub outros_diario()
'declarations
Dim last_row_source As Long
Dim last_row_destination As Long
Dim source_book As Workbook
Dim source_sheet As Worksheet
Dim dest_sheet1 As Worksheet
Dim dest_sheet2 As Worksheet
'set references to the two paste destinations
Set dest_sheet1 = ThisWorkbook.Sheets("outros")
Set dest_sheet2 = ThisWorkbook.Sheets("dados_diarios")
'delete-clear sheet: outros
dest_sheet1.Cells.Delete Shift:=xlUp
'open the workbook as reference 'source_book'
Set source_book = Workbooks.Open("N:\RH\Cantina\Lista_OUTROS.xlsx")
'set a reference to the activesheet and call it 'source_sheet'
Set source_sheet = source_book.ActiveSheet
'copy source_sheet to dest_sheet1 [outros]
source_sheet.Cells.Copy dest_sheet1.Range("A1")
'find where the data now stops on the [outros]
last_row_source = dest_sheet1.Cells(dest_sheet1.Rows.Count, "B").End(xlUp).Row
'find where the data stops on [dados_diarios]
last_row_destination = dest_sheet2.Cells(dest_sheet2.Rows.Count, "B").End(xlUp).Row
'copy data values from [outros] to [dados_diarios] ignoring first 7 rows
dest_sheet2.Range("A" & last_row_destination + 1).Resize(last_row_source - 7, 14).Value = dest_sheet1.Range("B8:O" & last_row_source).Value
'close the source workbook, without saving
source_book.Close False
End Sub
I am trying to copy from a macro enabled workbook to a .csv file, but for some reason the paste part paste everything in Column A only. VBA coding is below. Please help me figure out why it will not paste into the same cells as it copies. When I run the macro step by step it works perfect, however when it runs by itself it paste all data in Column A.
Sheets("Input").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Workbooks.Open Filename:="C:\temp\MyFile.csv"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Export Worksheet to CSV
An Alternative
If whatever you are trying to select is the only data in the worksheet, you can just copy the worksheet, which creates a new workbook containing only this worksheet and finally save it as a CSV file.
Option Explicit
Sub ExportWorksheetToCSVtest()
Const FilePath As String = "C:\temp\MyFile.csv"
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Input")
ExportWorksheetToCSV ws, FilePath
End Sub
Sub ExportWorksheetToCSV( _
ByVal ws As Worksheet, _
ByVal FilePath As String)
If ws Is Nothing Then Exit Sub
ws.Copy
With ActiveWorkbook
Application.DisplayAlerts = False
.SaveAs FilePath, xlCSV
Application.DisplayAlerts = True
.Close SaveChanges:=False
End With
End Sub
Updated with improved answer.
Not sure what you're doing wrong with your sheet, but this will work. Don't use Select.
Dim CopyRange As Range, copySheet As Worksheet
Set copySheet = ActiveSheet
Set CopyRange = Intersect(Range("A:C"), copySheet.UsedRange)
Dim theValues()
theValues = CopyRange.Value
Workbooks.Open Filename:="C:\temp\MyFile.csv"
Dim theCSV As Workbook
Set theCSV = ActiveWorkbook
theCSV.Sheets(1).Range("A1").Resize(UBound(theValues), UBound(theValues, 2)) = theValues
#PGSystemTester: This code did the same thing. Everything is pasted in Column A only.
#VBasic2008: This worked, but also gave unexpected errors.
What I did to make it work was basically run the same macro twice. I am not sure why this works. But the first time the macro runs, it pastes everything in Column A. When it runs again, it pastes correctly. So I just doubled the coding for the macro and now it works fine.
Thanks for the help!
good people, I hope you have a nice day. I am new to Excel Macro VBA here. I need to build Excel Macro Enabled Workbook for specific data processing.
Background: I am trying to copy data as values from every sheet from "source" workbook to a table in my master workbook, then when every data on every sheet has been copied, I need to remove duplicates from that table in my master workbook.
Problem: The number of sheets in "source" workbook is uncertain.
Goal: To copy from every sheet in "source" workbook, stacked in my master workbook then remove duplicates in my master workbook.
I provided my set of code for single sheet "source" workbook, please help me achieve my goal. I tried using do while loop, do until loop but they failed to execute my code
Sub Copy_SourceToMaster()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).Activate
Range("C6").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ThisWorkbook.Activate
ActiveSheet.Range("B4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
OpenBook.Close False
End If
Application.ScreenUpdating = True
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = ActiveSheet
Set StartCell = Range("B5")
'Find Last Row and Column
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
'Select Range
sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
Selection.RemoveDuplicates Columns:=2, Header:= _
xlYes
Range("B5").Select
Selection.End(xlDown).Select
End Sub
In order to count the worksheets in a workbook, you can simply use this:
Whatever_Workbook.Sheets.Count
In top of this, in your code you're doing quite some copy-paste, you can heavily simplify this using destination_range.Value = source_range.Value inside a for-loop. (See How to avoid using Select in Excel VBA for more information)
I'm creating a report everyday and the data needed are:
Open file #1 with file name: file1\today_23012015 for today.
In file #1 i need to get the items with yesterday's date which is 22012015 and copy those and paste it to the new workbook1.
Open file #2 with file name: file2\today_23012015 for today.
In file #2 I need to get the items with yesterday's date which is 22012015 and copy and paste to the sheet 2 of workbook1.
Can anyone help me create macro to this?
Sub Macro17()
'
' Macro17 Macro
'
'
Workbooks.Open Filename:="C:\Users\estillor\Desktop\file1240115.xlsx"
Windows("With macro.xlsm").Activate
Windows("file1240115.xlsx").Activate
ActiveCell.Offset(-8, -11).Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$D$24").AutoFilter Field:=4, Operator:= _
xlFilterValues, Criteria2:=Array(2, "1/23/2015")
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("With macro.xlsm").Activate
Sheets("Sheet1").Select
ActiveSheet.Paste
Windows("file1240115.xlsx").Activate
Windows("With macro.xlsm").Activate
Workbooks.Open Filename:="C:\Users\estillor\Desktop\file2240115.xlsx"
ActiveCell.Offset(-4, -16).Range("A1").Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveSheet.Range("$A$1:$D$10").AutoFilter Field:=4, Operator:= _
xlFilterValues, Criteria2:=Array(2, "1/23/2015")
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("With macro.xlsm").Activate
Sheets("Sheet2").Select
ActiveSheet.Paste
End Sub
This will be a process to get this working completely,
Practice with this code, adjust the folder locations and file names.
Once you get this to work for you, post back with a more detailed question.
Sub Do_Something_Cool()
Dim wb As Workbook, ws As Worksheet
Dim Bk As Workbook, sh As Worksheet
Dim dirt As String
Dim FnM As String
Dim FileNm As String
Dim Rws As Long, Rng As Range
dirt = "C:\Users\Dave\Downloads\"'adjust location
FnM = "file1240115.xlsx"
FileNm = dirt & FnM
Application.ScreenUpdating = 0
Set wb = Workbooks("WithMacro.xlsm")
Set ws = wb.Sheets("Sheet1")
Set Bk = Workbooks.Open(FileNm)
Set sh = Bk.Worksheets(1)
With sh
Rws = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A1").AutoFilter Field:=4, Criteria1:="=1/23/2015"
Set Rng = .Range(.Cells(2, "A"), .Cells(Rws, "D")).SpecialCells(xlCellTypeVisible)
Rng.Copy Destination:=ws.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
.AutoFilterMode = 0
Bk.Close True
End With
End Sub