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
Related
I'm fairly new to VBA user-forms so hopefully it's an easy fix.
I am using this code to move my entries from one sheet to another within the same workbook,but its working with some errors.
*I want it work on a specific sheet but its working on the active sheet.
**I want that after moving entries it should auto clear the specific sheet ( and I don't know how to do that :( )
Here is my code:
Private Sub CommandButton8_Click() 'Move Button
For Each cell In ThisWorkbook.Sheets("Daily").Range("endRange")
If IsDate(cell) = True Then
myEndRow = cell.Row
End If
Next cell
ThisWorkbook.Worksheets("Daily").Range("A2:E10000" & myEndRow).Select
Selection.Copy
Sheets("Data").Select
'Range("A2660").Select
ThisWorkbook.Worksheets("Data").Range("a99999").End(xlUp).Select
ActiveCell(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
Here is the link for the file:
Link
In your daily sheet in the code associated with the button put the following.
Please note i am not sure of the purpose of your test to see if there is a date. If you can clarify this i can amend the code accordingly. You don't need a button in the data sheet as this is where you are copying to. Make sure this code only resides in the sheet associated with the button i.e. Daily and does not exist elsewhere in the workbook.
Private Sub CommandButton1_Click() 'Move Button
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim rangeToCopy As Range
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Daily")
Set wsTarget = wb.Worksheets("Data")
Dim NextRow As Long
NextRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1 'Find next free row in Data sheet
Set rangeToCopy = wsSource.Range("A1").CurrentRegion.Offset(1, 0) 'get current set of rows that have data excluding header in daily sheet
rangeToCopy.Copy wsTarget.Cells(NextRow, "A") 'copy the new data from daily across to the next free row in the data sheet
rangeToCopy.ClearContents 'clear the contents of the daily sheet under the header
End Sub
I have 50 excel workbooks with the same range "SensResultsCopy" in the same sheet in each of those workbooks ("VAL"). I want to copy the data from those sheets into my open workbook. The workbook to be copied from is dynamic and taken from the range ("ProjModel"), but I don't know how to make the paste to location dynamic. The data from each workbook needs to go into its own sheet which has a named range for where the data needs to go, so workbook 1's data needs to go into the sheet named "1" and the range named "SensResPaste1", workbook 2's data needs to go into the sheet named "2" and the range named "SensResPaste1", etc. I want to make this part of the VBA dynamic using the range "ActiveProjModel" to determine the sheet and the range "PasteRange" as the range to be pasted into:
y.Sheets("1").Range("SensResPaste1")
At the moment I only know how to do this for a specific sheet and range i.e. in the example above, sheet 1. The full code is below. Thanks!
Sub DataCapture2()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Dim x As Workbook
Dim y As Workbook
Dim ws1 As Worksheet
'## Open both workbooks first:
Set y = ThisWorkbook
Set x = Workbooks.Open(Range("ProjModel"))
'Copy from x:
x.Sheets("VAL").Range("SensResultsCopy").Copy
'Paste to Worksheet in y:
y.Sheets("1").Range("SensResPaste1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Close x:
x.Close
I'm fairly new to VBA coding, so please pardon any ignorance.
How can I copy from one sheet (DIC) in workbook 1 and paste values in a sheet (Archive) in a second workbook starting from the first empty row? I don't have the second worksheet open often, so if it can be done without keeping it open, that would be preferred.
I compiled a code to get it to copy into a second sheet within the same workbook, but I'm stumped when it comes to getting it into the second workbook.
Here's the code that I have so far:
Sub copytoarchive()
'Copy From DIC
Sheets("DIC").Select
Range("A4:Q4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Paste into Archive
Sheets("Archive").Select
Dim NextRow As Range
Set NextRow = Range("A65536").End(xlUp).Offset(1, 0)
NextRow.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Clear Memory
Set NextRow = Nothing
End Sub
avoid all that Select/Selection an refer to fully qualified ranges
try this (commented) code:
Option Explicit
Sub copytoarchive()
Dim destSht As Worksheet
Workbooks.Open ("C:\...\FileToCopyTo.xlsx") '<- at opening a workbook it becomes the active one
Set destSht = ActiveWorkbook.Worksheets("Archive") '<-- set the destination worksheet in the activeworkbook
With ThisWorkbook.Worksheets("DIC") '<--refer to your source worksheet in the workbook this macro resides in
With .Range(.Range("A4:Q4"), .Range("A4:Q4").End(xlDown)) '<--| refer to your range whose values are to be copied
destSht.Cells(destSht.Rows.Count, 1).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value '<--| copy values in a equally sized range in destination worksheet starting at the first empty cell in column "A"
End With
End With
destSht.Parent.Close True '<--| close the destination workbook, which is obtained as the Parent object of the destination worksheet
End Sub
just change "C:...\FileToCopyTo.xlsx" with your actual destination workbook full path
be aware that such a range as you selected may incur in an error should there be no filled rows below "A4:B4"
You can certainly copy a range from a closed workbook.
http://www.rondebruin.nl/win/s3/win024.htm
I don't believe you can save data to a closed workbook. I can't even imagine how that would work.
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