I know this issue has been solved a lot of time, but I can't fix it.
Here is my code :
Sub MàJ_Pluri()
'
' MàJ_Pluri Macro
'
'chemin vers fichier pluri = chemin2
Range("U35").Select
Selection.Copy
Range("U36").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim chemin2 As String
chemin2 = Range("U36").Value
Dim chemin As String
Année = Range("C4").Value
Sheets("Création DC").Select
Sheets("Suivi Pluri-annuel").Visible = True
Rows("3:3").Select
Selection.Copy
Workbooks.Open Filename:= _
chemin2 _
, UpdateLinks:=0
'
ActiveSheet.ShowAllData
'
Dim LastRow As Integer
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range("$A$2:$AT" & LastRow).AutoFilter Field:=1, Criteria1:=Année
Range("A2").Select
ActiveCell.Offset(2, 0).Select
ActiveCell.EntireRow.Insert
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Windows("Gestion DC projet V.2.2.xlsm").Activate
Sheets("Suivi Pluri-annuel").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Création DC").Select
Range("C2:D2").Select
End Sub
So basicaly, my goal is to open the sheet in the first Workbook, copy what is in the row 3, open the second workbook, insert a blank row beneath the 2nd row, and paste in this row (which is always the 4th). Everything is working except that nothing is copying in the row.
Do you have any ideas ? Help would be really appreciated !
Thank you !
First open workbooks, assign them to variable and then do rest of the operations.
Nothing is copied because you're copying and then opening next workbook, so the copying method is automatically cleared.
Related
I have a Macro that copies and pastes from one excel document to another. For some reason, I had an error when using pastespecial immediately after copying and pasting from the other source doc. So as a workaround I just pasted normally, and then copied it again and then used pastespecial. My problem is that when running this Macro for some reason it adds a space to the end of the numbers turning them into text. Meaning that my graphs don't recognize them.
Workbooks.Open (fileLocation & "/" & fileName & fileType)
Worksheets(sourceWorksheet).Select
rowInUse = 46 'Add data row and name of sheet being imported into
mySheet = "sheet2"
pasteLocation = "D5"
lastColumn = ActiveSheet.Cells(rowInUse, Columns.Count).End(xlToLeft).Column
Range(Cells(rowInUse, firstColumn), Cells(rowInUse, lastColumn)).Copy
ActiveWorkbook.Close SaveChanges:=False
Worksheets(mySheet).Select
Range(tempPasteLocation).Select
ActiveSheet.Paste
Sheets(mySheet).Select
Range(tempPasteLocation, Cells(tempRow, tempColumn + lastColumn)).Select
Selection.Copy
Range(pasteLocation).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range(tempPasteLocation, Cells(tempRow, tempColumn + lastColumn)).Select
Selection.ClearContents
Does anyone have any idea why this is happening or how to fix it?
Thank you
Perform a direct value transfer instead of Copy, PasteSpecial, Values.
Replace,
Sheets(mySheet).Select
Range(tempPasteLocation, Cells(tempRow, tempColumn + lastColumn)).Select
Selection.Copy
Range(pasteLocation).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
With this,
with workSheets(mySheet)
with .Range(tempPasteLocation, .Cells(tempRow, tempColumn + lastColumn))
.Range(pasteLocation).resize(.rows.count, .columns.count) = .value2
end with
end with
I have looked thoroughly at the current answers for this problem and none of them have fixed mine.
The operation is simply copying a selection of a sheet and copying to a new book called budget.
Again I have tried multiple different ways of doing the same thing and none of them seem to change this error. The select method works,it only breaks when I try to paste.
Code:
Range("B3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Dim wk As Workbook
Set wk = Workbooks.Add
wk.SaveAs FileName:=ThisWorkbook.path & "\" & "Budget.xlsx"
wk.Activate
wk.Unprotect
wk.Worksheets("Sheet1").Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Thanks,
If you try exactly the steps in the code manually, you will find it also fails. The issue is that inbetween copying the cells and trying to paste them, you are creating a new workbook and saving it. This cancels copy/paste mode (i.e. the "marching ants" around the copied range disappear), so there is nothing to paste.
The solution is to not use Selection at all. In general any time you find yourself writing .Select in VBA you're doing it wrong (see this question for detail). Here is how I would re-write your code:
Dim wk As Workbook
Set wk = Workbooks.Add
wk.SaveAs Filename:=ThisWorkbook.Path & "\" & "Budget.xlsx"
ThisWorkbook.Range("B3").CurrentRegion.Copy
wk.Worksheets("Sheet1").Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Try the code below (explanation inside the code as comments):
Dim wk As Workbook
Set wk = Workbooks.Add
wk.SaveAs Filename:=ThisWorkbook.Path & "\" & "Budget.xlsx"
wk.Activate
wk.Unprotect
' have the Copy>>Paste section together
Dim LastCol As Long
Dim LastRow As Long
' you never mentioned which sheet to copy from, I used the first index
With ThisWorkbook.Sheets(1)
LastCol = .Range("B3").End(xlToRight).Column
LastRow = .Range("B3").End(xlDown).Row
.Range("B3", .Cells(LastRow, LastCol)).Copy ' <-- Copy without Select
End With
' Paste without Select
wk.Worksheets("Sheet1").Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
I have a input workbook, from which I will copy first row and paste it in another excel workbook (wbET). This I have to do for the number of rows in my input workbook.
I have code for first row. I have to do it for all the rows. can any one help me out
code:
Option Explicit
Dim wbIP As Workbook
Dim wbJT As Workbook
Dim wbET As Workbook
Dim mypathET As String
Dim mypathJT As String
Dim mypathIP As String
Dim vals As Variant
Sub tool()
mypathET = "C:\Documents and Settings\madinenih\Desktop\PremiumCalcutionTool"
mypathJT = "C:\Documents and Settings\madinenih\Desktop\Japancalculationtool"
mypathIP = "C:\Documents and Settings\madinenih\Desktop\A01"
'
'Set wbJT = Workbooks.Open(Filename:=mypathJT)
Set wbIP = Workbooks.Open(Filename:=mypathIP)
wbIP.Activate
'Rows("1:1").Select
'Selection.Copy
wbIP.Sheets("A01").Range("A1:IU1").Copy
Set wbET = Workbooks.Open(Filename:=mypathET)
wbET.Activate
wbET.Sheets("Input file data").Range("A3:IU3").PasteSpecial
'wbET.Activate
Application.Run (wbET.Name & "!run1")
Call Createexcels
wbIP.Activate
'Rows("1:1").Select
'Selection.Copy
wbIP.Sheets("A01").Range("A1:IU1").Copy
Set wbJT = Workbooks.Open(Filename:=mypathJT)
wbJT.Activate
wbJT.Sheets(2).Range("A5:IU5").PasteSpecial
'Application.Run (wbJT.Name & "!run1")
Call openexcel
Call compare
End Sub
Sub Createexcels()
Dim NewBook As Workbook
vals = "test"
Set NewBook = Workbooks.Add
NewBook.SaveAs Filename:=vals
'Workbooks("Whatever.xlsx").Worksheets("output").Range("A1:K10").Copy
'NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteValues)
' NewBook.Worksheets("Sheet1").Activate
wbET.Activate
wbET.Sheets("Calculation").Range("L2:L41").Copy
NewBook.Worksheets("Sheet1").Activate
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wbET.Activate
wbET.Sheets("Calculation").Range("L44:L61").Select
Application.CutCopyMode = False
Selection.Copy
Windows(vals).Activate
Range("A44").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wbET.Activate
wbET.Sheets("Calculation").Range("L64:L69").Select
Application.CutCopyMode = False
Selection.Copy
Windows(vals).Activate
Range("A63").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wbET.Activate
wbET.Sheets("Calculation").Range("L72:L81").Select
Application.CutCopyMode = False
Selection.Copy
Windows(vals).Activate
Range("A70").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:A").EntireColumn.AutoFit
NewBook.Save
End Sub
You need to loop through all of the rows in your Input worksheet. To start you need to get the last used row in our input sheet.
' use this in your loop. It looks like you are starting on row 3 of your input sheet.
Dim LastRow as Long
LastRow = Activesheet.Cells(Activesheet.Rows.Count, 2).End(xlUp).Row
Dim i as Long
For i = 3 to LastRow
' Code to copy each row goes here
' You will need to change how you are referencing your range
wbET.Sheets("Input file data").Range("A" & i & ":IU" & i).PasteSpecial
Next i
you need to find the last row and last column
using last row and column as reference, you can make the copy paste method easily
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'm really new to programming in VBA and having a problem with this code I'm trying to write. I am wanting the code to figure out the first row in column A that is unused then copy and paste data from a different part of the sheet into that row.
Sub CopyandPaste()
Dim RowLast As Long
RowLast = ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Set NewRange = ThisWorkbook.Worksheets("Sheet2").Cells(RowLast, 1)
ThisWorkbook.Worksheets("Sheet1").Cells(8, "B").Select
Selection.Copy
Range("NewRange").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Any help would be extremely helpful.
Try this code :
Sub CopyandPaste()
Dim RowLast As Long
ThisWorkbook.Activate
With Worksheets("Sheet2")
RowLast = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Sheets("Sheet1").Cells(8, "B").Copy Sheets("Sheet2").Cells(RowLast, 1)
End With
End Sub
I have added comments into the code explaining changes I made.
Sub CopyandPaste()
Dim RowLast As Long
Dim newRange As Range
'this works easier if I understand your intent right
'I generally use some large row number with Excel 2010
'You may ahve to make this smaller if you are in 03
RowLast = Sheets("Sheet2").Range("B99999").End(xlUp) + 1
'if you KNOW you have continuous data in this column (no spaces)
RowLast = Sheets("Sheet2").Range("B1").End(xldown) + 1
'this is slightly better way to do this
Set newRange = ThisWorkbook.Worksheets("Sheet2").Range("A" & RowLast)
'don't do this
'ThisWorkbook.Worksheets("Sheet1").Cells(8, "B").Select
'Selection.Copy
'do this instead
Sheets("Sheet1").Range("B8").Copy
newRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'you were attempting to use a variable name (newrange) as a
'name of a named range in the Excel sheet
'use the variable range itself (as above)
End Sub