I wrote a script to copy sheet by sheet from ThisWorkbook to another workbook. Everything seems to work fine except for the column width of the last sheet, and only the last sheet. Some columns have wrapped text which is not found in the original. I eliminated most of the code and only copied formats and column widths. Still, the column widths are different from that in the original file. And this only happens with the last sheet.
Sub copy_all()
Dim rng As Range
Dim i As Integer
Dim destBook As Workbook
Set destBook = Workbooks("Book3")
With destBook
For i = 1 To ThisWorkbook.Sheets.Count
Set rng = ThisWorkbook.Sheets(i).UsedRange
rng.Copy
.Sheets(i).Range("A1").PasteSpecial Paste:=xlPasteFormats
.Sheets(i).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
Next i
End With
End Sub
I even wrote a script to list the column widths of the original and copied files so it'd easy to compare. Indeed, only the last page of the column widths are different. All the other 13 pairs of pages of the original and copied files have the identical column widths.
As you can see from the following picture, only some of the column width on the last page are different from the original, not every one of them. Some are identical to the original. Only those with a width of 87 are copied to becoming a width of 48.
My question is what is wrong with the copy script? Thanks in advance for any help.
Related
I have an Excel workbook with multiple sheets, which are fed by data imported from multiple external excel files. To complete this action, I successfully built VBA code that allows the user to open the files.
Behind the scenes, one of the subs imports data from the General Ledger raw data into a spreadsheet with multiple columns. I am attaching a couple screen grabs here to show what is happening:
The pre-existing data looks like this:
Raw data once downloads will look like this:
Once the macro runs, the previous columns populate as intended, but because the last two columns are populated intermittently, they end up doing this:
I only summarized columns in these images, as the workbook has 28 columns preceding the two columns.
Due to the size of the data and the macro itself, I would like to maintain the structure of the code. Especially since it is intended that this macro be transferred to other general ledger workbooks.
My macro looks like this (summarized for time):
1. Sub Import_GL1001
2. Dim FileToOpen As Variant
3. Dim OpenBook As Workbook
4. Application.ScreenUpdating = False
5. FileToOpen=Application.GetOpenFileName(Title="Import_GL1001",FileFilter:="ExcelFiles (*xlsx*),*xlsx*")
6. If FileToOpen<> False Then
7. Set OpenBook=Application.Workbooks.Open(FileToOpen)
8. OpenBook.Sheets(1).Range("$A$2:$A$1500").Copy
9. ThisWorkbook.Worksheets("GL 1001.10").Range("A"&Rows.Count).End(xlUp).Offset(1,0).PasteSpecial xlPasteValues
10. OpenBook.Sheets(1).Range("$B$2:$B$1500").Copy
11. ThisWorkbook.Worksheets("GL 1001.10").Range("B"&Rows.Count).End(xlUp).Offset(1,0).PasteSpecialxlPasteValues
12. ......
13. OpenBook.Sheets(1).Range("$AC$2:AC$1500").Copy
14. ThisWorkbook.Worksheets("GL 1001.10").Range("AD"&Rows.Count).End(xlUp).Offset(1,0).PasteSpecial xlPastevalues
15. OpenBook.Sheets(1).Range("$AD$2:$AD$1500").Copy
15. ThisWorkbook.Worksheets("GL 1001.10").Range("AF"&Rows.Count).End(xlUp).Offset(1,0).PasteSpecialxlPasteValues
In an ideal world, the values would copy and paste as is, blanks and all, so when the macro is run in the future the two columns in question do not change position based on the last blank cell. I tried multiple methods and variations, but the only logical thing I could think of is if I manage to find a way to insert a "0" into each cell that is blank every time the data is imported, without changing all the blank cells (i.e. if we only have 30 rows of data, I don't want all of the blank cells in AF:AF to be "0"). If the cells have a value at all, then that means that the macro itself won't have to be dramatically retooled.
Please, try the next way:
The last row where to paste the values should be calculated only once, based on a column you know that it is all the time filled with values.
Dim lastERow As Long, sh As Worksheet
Set sh = ThisWorkbook.Worksheets("GL 1001.10")
lastERow = sh.Range("A" & sh.Rows.Count).End(xlUp).Offset(1,0).row 'last empty row
Then use this reference for all the columns where you intend pasting starting from the same empty cell row:
'your existing code
OpenBook.Sheets(1).Range("$A$2:$A$1500").Copy
sh.Range("A" & lastERow).PasteSpecial xlPasteValues
'...
'...
OpenBook.Sheets(1).Range("$AC$2:AC$1500").Copy
sh.Range("AD" & lastERow).PasteSpecial xlPastevalues
OpenBook.Sheets(1).Range("$AD$2:$AD$1500").Copy
sh.Range("AF" & lastERow).PasteSpecial xlPastevalues
In this way, the code will paste starting from the same empty row, in all columns.
If you want following your way of solving, please run the next code, but after your existing code runs. It will take the reference from the last filled cell of the A:A column:
Sub ZeroInEmptyCells()
Dim sh As Worksheet, lastRow As Long, rngEmpt As Range
Set sh = ThisWorkbook.Worksheets("GL 1001.10")
lastRow = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row in column A:A
On Error Resume Next 'if no empty cells, the next code line will return an error (without this line...):
Set rngEmpt = Union(sh.Range("AD1:AD" & lastRow), sh.Range("AF1:AF" & lastRow)).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rngEmpt Is Nothing Then rngEmpt.value = 0
End Sub
I'm attempting to find a column using the column header name, then select all the data from the column (including the blank cells) & paste into another range.
Currently I can only copy until the 1st blank cell. I have seen similar problems on the board but the solutions I have seen are coming from the angle of knowing which column it is in first & then finding the last row from the bottom of the worksheet.
Workbooks("PS & Config - Actuals & FC.xlsm").Worksheets(2).Range("A3").CurrentRegion.Find(What:="FFA Name").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Range("A3").Select
ActiveSheet.Paste
To find the column use Match wit the column header name. Once you have that column, set the values in the destination range to be the same as that column. Selecting, copying, and pasting in VBA are unnecessary as the values themselves can be moved--plus it adds load.
I don't have Office anymore so I'm running this from memory. I hope it helps.
dim wb as workbook, ws1, ws2 as worksheet, myCol, myRow as long
set wb=excel.thisworkbook 'assuming this code goes in that workbook
set ws1=wb.sheets(2) 'set variables
myCol=worksheetfunction.match("FFA Name",ws1.[a1:zz1],0) 'search through 1st row
myRow=ws1.[a3].currentregion.rows.count 'grab last row containing data in this set
'do not select, nor copy and paste, if it can all be done with VBA. This can.
set ws2=wb.sheets.add 'a little rusty on this line, you can get the method from the macro recorder
ws2.cells(1,1).resize(myrow).value=ws1.cells(1,myCol).resize(myrow).value
The reason your original code stops when there's a blank cell is because the .end() method simulates pushing the end key and then an arrow, which goes to the first/last contiguous cell with data.
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Having a small issue. I have a large piece of code that takes a reference number selected by the user and locates corresponding rows (there can be multiple rows or none to locate) on multiple other sheets by filtering and then copying the data.
This works well except it copies all visible data (columns A-N) when I really want it to copy columns A to K (as L to N on the paste sheet is where I have formulas that set reference numbers and therefore can't be pasted over).
I have tried a couple of changes to the below section of code including offset however it either ignores the offset (probably because I'm using xlCellTypeVisible which I had to do as the data that needs to be copied can be across multiple non sequential rows) or I get an error about selection method not supported.
Any thoughts?
sheet that is being copied - DbExtract
Sheet that data is pasted to - DuplicateRecords
Thanks.
Sub UpdateInputWithExisting()
' Other code that works using set with values and active cell offset with values for other sheets
Sheets("TK_Register").Range("A1").CurrentRegion.AutoFilter field:=12, Criteria1:=RefID
Dim DbExtract, DuplicateRecords As Worksheet
Set DbExtract = ThisWorkbook.Sheets("TK_Register")
Set DuplicateRecords = ThisWorkbook.Sheets("EditEx")
DbExtract.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).copy
DuplicateRecords.Cells(31, 3).PasteSpecial xlPasteValues
On Error Resume Next
Sheets("TK_Register").ShowAllData
On Error GoTo 0
ActiveWorkbook.RefreshAll
Sheets("EditEx").Select
ActiveWindow.SmallScroll Down:=-120
Range("B14:M14").Select
MsgBox ("Record Retrieved. Make your changes and ensure you click 'Save Changes' to update the Master Registers")
End Sub
Need to use .Resize method. Replace this line:
DbExtract.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).copy
With this:
With DbExtract.Range("A1").CurrentRegion
.Resize(, .Columns.Count - 3).SpecialCells(xlCellTypeVisible).Copy
End With
I am working with multiple sheets within a workbook. Each sheet has an identical header row. I would like to write a macro to copy a range of data from each sheet (A2:L2 to the last row of data on a sheet) and paste it into the first empty cell in Column A of master sheet.
What I have below doesn't seem to work. Any assistance is appreciated.
Dim Lastrow As Integer
Lastrow = ActiveSheet.Cells(Rows.Count,1).End(xlUp).Row
Sheets("Master Sheet").Range("A2:L10000).Clear
Sheets("Sheet1").Activate
Range("A2:L" & Lastrow).Select
Selection.Copy
Sheets("Master Sheet").Select
Range("A30000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1,0).Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet2").Activate
Range("A2:L" & Lastrow).Select
Selection.Copy
Sheets("Master Sheet").Select
Range("A30000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
You're almost there from the looks of it. It looks like you've recorded a macro which is a good place to start. The reason your specific code might not work is because of Sheets("Master Sheet").Range("A2:L10000).Clear. You're missing the end quote inside of the range. In any case though, I've chosen to leave that out so you don't accidentally clear your sheet when you're moving data across
So generally it's good to avoid using select and activate, but with a recorder you don't have much say in the matter. Below you can see how I can do operations directly with the range.
It's important to find the last row of the master sheet as well as your current sheet each time so you know the range you want to copy and where you can paste it. It's important to remember that you're always finding the last filled cell, so in the case of a paste destination, you need to add one more to the row value so you don't accidentally overwrite some data.
For loops are pretty useful, I'm not sure what names you have for the rest of your sheets, but luckily in VBA you can use For each. so what this does is it cycles through every single item that you specify. In this case I've specified worksheets. The only problem now though, is we don't want to try copying and pasting into the same Master Sheet, so we need to do a quick check to make sure we're not on the master sheet. I've done this simply by comparing the name of the worksheet to what you've put as the name of the master sheet.
Interestingly when you copy something, you only need to specify the top left cell and it'll fill in the rest of it. It makes life a little easier because you don't need to figure out the exact dimensions of the array you're pasting. The Copy function in VBA has an optional parameter called Destination which you can use to tell it where you want to paste it right away.
It's also good to fully specify ranges when you're using them so instead of Range, you can see how I use ThisWorkbook.Worksheets("Master Sheet").Range. This tells the computer exactly where you want to reference; whereas Range makes the computer sort of guess, so it assumes you mean the active sheet, which might not be what you want.
Sub Paster()
Dim LastRowCurr As Long
Dim LastRowMaster As Long
Dim wksht As Worksheet
For Each wksht In ThisWorkbook.Worksheets
If Not wksht.Name = "Master Sheet" Then
LastRowCurr = wksht.Cells(wksht.Rows.Count, 1).End(xlUp).Row
LastRowMaster = Worksheets("Master Sheet").Cells(Worksheets("Master Sheet").Rows.Count, 1).End(xlUp).Row + 1
Range("A2:L" & LastRowCurr).Copy Destination:=ThisWorkbook.Worksheets("Master Sheet").Cells(LastRowMaster, "A")
End If
Next wksht
End Sub
As part of my project I have a Table which includes lookup formulas in each column that are dragged down the whole table. Depending on the case only the first x rows return values. I included an iferror so that the lookups that don't return values return "".
Now I want to copy the rows of the table that return values to the first empty row in a different table in a different worksheet.
The code I have so far:
Sub Copy_Results()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet2")
copySheet.Range("Table1").Copy
pasteSheet.ListObjects("Table2").Range.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Now the big problem is that I want to be able to execute this macro multiple times, each time the values from Table 1 should be pasted below the preexisting values in table 2.
The point being that each time the lookup values change meaning I get new results I want to paste them in a table where all the results are documented.
Issues that I had so far:
The first Copy Paste usually works, but when I copy again the values get pasted way below the first ones outside of the table. Usually the full length of the table away. I guess this is because the whole copy table is filled with formulas.
The easiest way to do this is to restrict the cells that you are going to copy using the SpecialCells method:
https://msdn.microsoft.com/en-us/library/office/ff196157.aspx
In this case you only want to copy the formulas that have numbers as the values, so this would be the syntax:
SpecialCells(xlCellTypeFormulas, xlNumbers)
Put into your code it would be:
copySheet.Range("Table1").SpecialCells(xlCellTypeFormulas, xlNumbers).Copy
You can see this in action outside of your code by selecting the complete range in your source sheet then pressing F5, selecting the "Special" button at the bottom of the dialog that pops up, then select "Formulas" and "Numbers".
To make sure it pastes in the next available row, use the CurrentRegion property:
https://msdn.microsoft.com/en-us/library/office/ff196678.aspx?f=255&MSPPError=-2147217396
This code will tell you what the last row is in the used area defined by cell A1:
pasteSheet.cells(1,1).CurrentRegion.Rows.Count
I believe the paste command you're looking for will be close to this (hard to test exactly without your spreadsheet):
pasteSheet.cells(pasteSheet.cells(1,1).CurrentRegion.Rows.Count + 1, 1).PasteSpecial xlPasteValues