I've seen answers to this questions that are variations of what I'm looking for but when I attempt to modify the code to my situation, I keep getting error messages.
I have two workbooks, a Master "Template" and a monthly report for YTDJune2015. Each has 15 sheets which are the same for both, and I want to copy data from the monthly report into the Template which has formulas to calculate additional data for each of the 15 unique Sheets. I keep getting an error that there is a "type mismatch" so I haven't been able to test if the copy and pasting of individual sheets works. So far the code I have is:
'Sub ExtractData()
Dim SheetNames As Variant
Dim i As Integer
Application.ScreenUpdating = False
Range("C8:AB117").Select
FileNames = Application.GetOpenFilename(FileFilter:="Excel Filter (*.xlsx),*.xslx", Title:="Open File(s)", MultiSelect:=True)
For i = 1 To UBound(FileNames)
Workbooks.Open FileNames
Sheets("Total").Range("C8:AB117").Select
Selection.Copy
Windows("Template.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteAll, Transpose:=False
'Workbooks.Open FileNames(i)
'Sheets("Domestic").Range("C8:AB117").Select
'Selection.Copy
'Windows("Template.xlsm").Activate
'Selection.PasteSpecial Paste:=xlPasteAll, Transpose:=False'
You are sending an array when a string is expected:
Change
Workbooks.Open FileNames
To
Workbooks.Open FileNames(i)
Related
i have 2 CSV files orders_by_user_backlog and orders_by_user_pivot. I want to create with VBA an .xlsx file called Orders by Users Report containing 2 sheets.
First sheet called backlog, i will just copy the data from orders_by_user_backlog.csv and paste it there.
Second sheet called pivot, i will copy the data from orders_by_user_pivot.csv and paste it there and refresh the pivot table in the same sheet with the new data.
I am using an .xlsx file as template called Orders By Users Template
Here is my code
Sub Orders_by_User_report()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'open the csv output from query orders by user backlog
Workbooks.Open FileName:="C:\Reports\orders_by_user_backlog.csv"
Cells.Select
Selection.Copy
Workbooks.Open FileName:= _
"C:\Reports\Report templates\Orders By Users Template.xlsx"
Sheets(1).Select
Cells.Select
ActiveSheet.Paste
'Bold and color top row, add autofilter, zoom 80% and autofit
Range("A1:H1").Select
Selection.Interior.Color = 255
Selection.Font.Bold = True
Selection.AutoFilter
ActiveWindow.Zoom = 80
Cells.Select
Cells.EntireColumn.AutoFit
'open the csv output from query orders by user pivot
Workbooks.Open FileName:="C:\Reports\orders_by_user_pivot.csv"
Cells.Select
Selection.Copy
Workbooks.Open FileName:= _
"C:\Reports\Report templates\Orders By Users Template.xlsx"
Sheets(2).Select
Cells.Select
ActiveSheet.Paste
'Bold and color top row, add autofilter, zoom 80% and autofit
Range("A1:D1").Select
Selection.Interior.Color = 255
Selection.Font.Bold = True
Selection.AutoFilter
ActiveWindow.Zoom = 80
Cells.Select
Cells.EntireColumn.AutoFit
'refresh pivot table
Sheets(2).Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
'save file as xlsx for the output
ActiveWorkbook.SaveAs FileName:= _
"C:\Reports\Orders by Users\Orders by Users Report " & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
ActiveWindow.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I know where is my problem, it's in the 'ActiveSheet' but i didn't know how to fix it. Everytime i am using
ActiveSheet.Paste
or
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
it shows me error in the second ActiveSheet.Paste, when i comment this part and try only with one CSV file it Pastes fine but then it stops again in the ActiveSheet.PivotTables.
Can anyone please advice me what to change in my code ? Thank you very much.
Assign parentage to your objects and work directly with the objects. It's cleaner, easier to read and debug and ensures you are working directly with the objects you want.
Code below is untested (and only deals with the question at hand).
Dim wbBacklog as Workbook, wbPivot as Workbook, wbTemplate as Workbook
Set wbTemplate = Workbooks.Open("C:\Reports\Report templates\Orders By Users Template.xlsx")
Set wbBacklog = Workbooks.Open("C:\Reports\orders_by_user_backlog.csv")
Set wbPivot = Workbooks.Open("C:\Reports\orders_by_user_backlog.csv")
wbBacklog.Sheets(1).UsedRange.Copy 'copy data
wbTemplate.Sheets(1).Range("A1").PasteSpecial xlPasteValues 'paste to template
wbPivot.Sheets(1).UsedRange.Copy 'copy data
wbTemplate.Sheets(2).Range("A1").PasteSpecial xlPasteValues
Also, to make it easier, define a dynamic named range for the data source of the PivotTable. SOmething like this formula.
=Offset(Sheet2!A1,0,0,counta(Sheets2!A:A),4)
Then, in your code,
wbTemplate.Sheets(2).PivotTables(1).Refresh
will work.
Lastly, read and study how and why to Avoid Select. It's a must in VBA programming in Excel.
I have two large workbooks with identical sheet names, and similar data. The source sheet has a bunch of colors applied to the cells, and I have to copy those colors to their respective cells in the destination sheet.
I've tried this suggestion:
How to copy an Excel color scheme from one workbook to another
But it didn't seem to do anything.
This is the code I wrote, but it locks up excel for a long time. Does it look right to you?
Sub CopyColors()
Dim x As Workbook
Dim y As Workbook
Dim SomeSheet As Worksheet
Dim SomeRange As Range
Set x = Workbooks.Open(" c:/PATH/Source.xlsm ")
Set y = Workbooks.Open(" c:/PATH/Destination.xlsm ")
y.Colors = x.Colors
For Each SomeSheet In x.Worksheets
For Each SomeRange In SomeSheet.Cells
y.Sheets(SomeSheet.Name).Range(SomeRange.Address).Interior.ColorIndex = SomeRange.Interior.ColorIndex
Next SomeRange
Next SomeSheet
End Sub
I decided it'd be a better use of my time to explore other options than to wait for this to pan out. If I don't get a better idea, I'll let this run overnight tonight.
You may be able to adapt this to sheets in different workbooks. Say we have two sheet in the same workbook. We want to copy the colors. Rather than looping of all the cells individually, we copy all the cells from the first sheet and and PasteSpecialFormats into the second worksheet:
From the Recorder:
Sub Macro2()
Sheets("Sheet1").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub
I have a macro running with the following code to copy data from one Excel file into another Excel file. Currently it is copying and pasting the data into the second Excel file. This means it overwrites any data that is in the second Excel file.
I would like it to insert the copied cells rather than paste over the data already in the workbook. How should I edit line 27 to make this work?
I think I need to use the following code but I'm not sure how to apply it to my original code.
InsertCopiedCells
Here is the original code that is pasting the data.
Const strFile As String = "E:\My Documents\file2\file\MonthlyReports\Data\file1.xlsx"
'Add the file location
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet
'-------------------------------------------------------------
'Open file with data to be copied
Set wbCopyFrom = Workbooks.Open(strFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(1)
'--------------------------------------------------------------
'Copy Range
wsCopyFrom.Range("A2:AA5000").Copy
wsCopyTo.Range("A2").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Replace
wsCopyTo.Range("A2").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
to
wsCopyTo.Range("A2").Insert xlShiftDown
I have a workbook that serves as source data for another Excel-based form (not a Userform, just a formatted spreadsheet). The source file has anywhere from 2-40 rows of data - starting from row 18 - and each row needs to be copied into the form and saved separately, i.e. 15 rows from the Source file equates to 15 distinct Form files.
Each cell within the row must be copied separately and pasted to specific cells on the Form. The Source form contains Clients and their relevant info. I am trying to use a macro on the Form to automatically pull line items from the Source file, save the Form as the client's name in a specified folder, and continue until a blank row is reached on the Source file. I have some basic VBA experience, but have little knowledge of loops, variables, or functions, which seem to be my best course of action here.
Here's what I have so far. All I've been able to accomplish is the copy/pasting of the first row from the Source file.
Range("B18").Select
Selection.Copy
Windows("Form.xls").Activate
Range("F7:K7").Select
ActiveSheet.Paste
Windows("Source.xls").Activate
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("D8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Source.xls").Activate
Range("D18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("H29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Source.xls").Activate
Range("E18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("E29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Source.xls").Activate
Range("F18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("D33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(“F7:K7”).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWorkbook.SaveAs
I can't even get my macro to save the Form by the client's name. I also know that my extensive use of "Range" and "Select" will slow my code down to a crawl, I just don't know how to make it more efficient. I've tried using a reference cell to that tells the macro which row of the Source file to copy but haven't had any luck down that road either. Any and all help will be greatly appreciated!
Here's a simple demo:
Note: Not Tested
Option Explicit
Sub CopyToForm()
Dim wbSource As Workbook, wbForm As Workbook
Dim wsSource As Worksheet, wsForm As Worksheet
Dim formpath As String, foldertosavepath as string
Dim lrow As Long, i As Integer
Set wbSource = Thisworkbook '~~> assuming you write your code in Source.xls
Set wsSource = wbSource.Sheets("NameOfYourSheet") '~~> put the source sheet name
'~~> put the path where your form template is saved here
formpath = "C:\Users\Username\FolderName\Processing Form.xls"
'~~> put the path where you want to save individual updated forms.
foldertosavepath = "C:\Users\Username\FolderDestination\"
With wsSource
'~~> get the number of rows with data
lrow = .Range("B" & .Rows.Count).End(xlUp).Row
If lrow < 18 Then Msgbox "No data for transfer": Exit Sub
For i = 18 to lrow
Set wbForm = Workbooks.Open(formpath) '~~> open the form
Set wsForm = wbForm.Sheets("Sheetname") '~~> put the form sheet name
'~~> proceed with the copying
.Range("B" & i).Copy: wsForm.Range("F7:K7").PasteSpecial xlPasteValue
.Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
.Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
.Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
.Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
'~~> Save the form using the client name, I assumed it is in B?
wbForm.SaveAs foldertosavepath & .Range("B" & i).Value & ".xls"
wbForm.Close True
Set wbForm = Nothing
Set wsForm = Nothing
Next
End With
End Sub
In above code, I assumed that Form.xls is the same as Processing Form.xls.
This should give you the logic.
I hope this get's you started.
This is not test as I've noted, so if you encounter errors, comment it out.
You are frequently activating the workbooks. that's your code slows down..Below code will work faster
Sub test()
Dim dwb As Workbook
Dim swb As Workbook
Set dwb = Workbooks("Form.xls")
Set swb = Workbooks("Source.xls")
Set awb = Workbooks("Processing Form.xls")
With swb
.ActiveSheet.Range("B18").Copy Destination:=dwb.Sheet1.Range("F7:K7")
.ActiveSheet.Range("C18").Copy Destination:=awb.Sheet1.Range("D8")
.ActiveSheet.Range("D18").Copy Destination:=awb.Sheet1.Range("H29")
.ActiveSheet.Range("e18").Copy Destination:=awb.Sheet1.Range("E29")
.ActiveSheet.Range("F18").Copy Destination:=awb.Sheet1.Range("D33")
End With
End Sub
This might help steer you in the right direction:
Dim i As Long
For i = 1 To 10
With Range("A" & i)
.Copy Workbooks("ToWorkbook.xlsx").Worksheets("Sheet1").Range("B" & i + 9)
.Copy Workbooks("ToAnother.xlsx").Worksheets("Sheet2").Range("C" & i + 8)
.Copy Workbooks("AnotherOne.xlsx").Worksheets("SheetA").Range("D" & i + 2)
End With
Next i
i To 10 is used as a counter to loop through the rows in the source workbook.
For each i, you're taking the range from column A (i.e., with this, do something), copying and pasting it into different cells in different workbooks. In the first round, Range("A1") is being copied into 3 different workbooks at Range("B10"), Range("C9") and Range("D3"), respectively. The next turn, Range("A2") from the source book is going to be copied and pasted into the same destination workbooks from last time, but in Range("B11"), Range("C10") and Range("D4"). It's just a matter of finding the pattern for the different forms you need to paste into.
I am new to VBA and have been using the site to piece together a solution.
I need to write a macro that prompts the user to open a file (wb2), copy a row of data from a Sheet1 in that workbook (wb2) and then paste it into the next empty row within the original workbook (wb) also on Sheet1. I got it to work up until I tried adding the code for pasting in the next empty row - I am now receiving the following error message, "Run-time error '438': Object doesn't support this property or method"
Any help would be greatly appreciated.
Sub test()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set selectedworkbook
Set wb2 = ActiveWorkbook
wb2.Range("A3:E3").Select
Selection.Copy
wb.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
wb2.Close
'Set targetworkbook
Set wb = ActiveWorkbook
End Sub
Just a quick note on the subject:
Instead of
wb2.Worksheets("Output").Range("J3:R3").Select
Selection.Copy
try
wb2.Worksheets("Output").Range("J3:R3").Copy
Also
Instead of
wb.Worksheets("Master").Range("C" & LastCellRowNumber).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
try
wb.Worksheets("Master").Range("C" & LastCellRowNumber).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Often times, Select creates unexplainable errors. Particularly when working with multiple workbooks, try to stay away from Select. This code comes almost directly from working code I have. Let us know if this doesn't fix the problem.
I re-worked the code and got it working. It's probably not the cleanest way to do it, but given my timeline and lack of VBA knowledge, it will have to do.
Many thanks to engineersmnky for their help.
Description: This code should be put into the worksheet you want to paste content into from another workbook. When it runs it will prompt you to open a workbook to copy from ("Output" worksheet), it will then select the cells you specify in the code (JR:R3), paste them in starting at the next empty row of your initial workbook (finding the last row in column C in the "Master" worksheet), and then it will close & save the workbook you just copied from.
Sub CommandButton1_Click()
'Last cell in column
Dim WS As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long
Set WS = Worksheets("Master")
With WS
Set LastCell = .Cells(.Rows.Count, "C").End(xlUp)
LastCellRowNumber = LastCell.Row + 1
End With
Dim wb As Workbook, wb2 As Workbook
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set selectedworkbook
Set wb2 = ActiveWorkbook
'Select cells to copy
wb2.Worksheets("Output").Range("J3:R3").Select
Selection.Copy
'Go back to original workbook you want to paste into
wb.Activate
'Paste starting at the last empty row
wb.Worksheets("Master").Range("C" & LastCellRowNumber).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
'Close and save the workbook you copied from
wb2.Save
wb2.Close
End Sub
Have you tried this
Selection.Copy
wb.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial xlPasteValues