I have a question about copy paste specific columns from one worksheet(ws_Copy) to another(ws_Dest). I need to loop through each column header and match it with the headers in ws_Copy. If it matches, I need to copy the whole column into the ws_Dest with the matched header.
Not sure if my explain is clear or not, here is the sample code:
Sub Import_data()
Dim path As String
Dim file As String
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lastcol As Integer
Dim lastrow_ir As Integer
Dim i As Integer
Dim m As Integer
path = ThisWorkbook.Sheets("MACROS").Range("import_path_IRHedge").Value
file = ThisWorkbook.Sheets("MACROS").Range("file_IRHedge").Value
'Set variables for copy and destination sheets
Set wsCopy = Workbooks(file).Sheets("data_ir_bpv")
Set wsDest = ThisWorkbook.Sheets("IR Hedge")
'Find last used column in the destination sheet
'Find last row in the copy sheet
lastcol = wsDest.Range("C:AD").Column
lastrow_ir = wsCopy_ir.Range("C" & Rows.Count).End(xlUp).Row
'Use the Match function to find the corresponding column to copy paste
For i = 3 To lastcol
Set Rng1 = wsCopy_ir.Range("C14:AC14")
m = Application.WorksheetFuntion.Match(wsDest.Cells(1, i).Value, Rng1, 0)
wsCopy_ir.Range("C14:C & lastrow_ir").Columns(m).Copy
wsDest.Range("C2").Columns(i).PasteSpecial xlPasteValues
Next i
Application.CutCopyMode = False
MsgBox "Data has been imported successfully"
End Sub
But the error message "Object doesn't support this property or method" kept showing up in the row:
m = Application.WorksheetFuntion.Match(wsDest.Cells(1, i).Value, Rng1, 0)
Any help would be appreciated!
Related
I am trying to consolidate multiple large excel files into one single file using the following code
Sub Macro1()
Application.DisplayAlerts = False
Dim Country As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
k = 2
For i = 1 To 50
Windows("Try2").Activate
Country = Worksheets("Names").Cells(i, 1).Value
Workbooks.Open Filename:= "C:path\" & Country & " "
ActiveWorkbook.Sheets("Main").Activate
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
Workbooks(Country).Sheets("Main").Range(Cells(1, 1), Cells(10000, 64)).Copy
Workbooks("Try2").Sheets("Output").Activate
Workbooks("Try2").Sheets("Output").Cells(k, 2).PasteSpecial xlPasteValues
Range(Cells(k, 1), Cells(k + 10000, 1)) = Country
finalrow2 = 10002 + k
k = finalrow2 + 1
Workbooks(Country).Sheets("Main").Activate
Workbooks(Country).Close SaveChanges:=False
Next i
End Sub
However after consolidating 2-3 files excel it is throwing buffer overflow error. We have around 50 files. I am trying to figure out if this is just a problem with excel unable to handle large files or there is something wrong with my code. Is there any way to guide excel to handle larger files sizes?
There's a couple of things here that could be throwing your macro off.
First, you're declaring i, j, and k as the 'integer' data type; problem with that is that the largest possible value an integer can hold is 32,767. If you go above that, you're going to get a buffer overflow.
Second, you're declaring variables that you don't use, and not declaring variables that you do use. As far as I can see, j isn't used anywhere in the code, but finalrow and finalrow2 are used but aren't declared anywhere.
I would suggest you replace your integer data types that could go very high with long data types (long integer). You might also want to use more descriptive names for your integers to make your code easier to read:
Dim iCycler as integer
Dim kStart as long
Dim FinalRow as Long
Dim FinalRow2 as Long
Run through that and see what you get.
EDITED TO ADD:
Here is a complete process that should suit you:
Sub Duplicator()
'Define the source file, sheet, and range
Dim wbkSource As Workbook
Dim shtSource As Worksheet
Dim rngSource As Range
'Define the target file, sheet and range
Dim wbkTarget As Workbook
Dim shtTarget As Worksheet
Dim rngTarget As Range
'Define the sheet with the list of countries
Dim shtControl As Worksheet
'Prepare control integers
Dim iLoop As Integer
Dim lLastRow As Long
'Define the target file as the active workbook
Set wbkTarget = ActiveWorkbook
Set shtTarget = wbkSource.Sheets("Output")
Set rngTarget = shtTarget.Range("A2")
Set shtControl = wbkTarget.Sheets("Names")
'Loop through the list
For iLoop = 1 To 50
'Open the source file and assign it to a variable.
Set wbkSource = Workbooks.Open("C:\path\" & shtControl.Cells(iLoop, 1).Value)
'Assign the source sheet
Set shtSource = wbkSource.Sheets("Main")
'Find the last row of data
lLastRow = shtSource.Range("A" & Rows.Count).End(xlUp).Row
'Use the last row to build a source range variable
Set rngSource = shtSource.Range("A1", "BL" & lLastRow)
'Check that there is space for the copy. If there is not, create a new sheet for the new data
If rngTarget.Row + lLastRow > shtTarget.Rows.Count Then
Set shtTarget = wbkTarget.Sheets.Add
shtTarget.Name = "Output 2"
Set rngTarget = shtTarget.Range("A2")
End If
'Use the size of rngSource to define the size of the target range
Set rngTarget = rngTarget.Resize(rngSource.Rows.Count, rngSource.Columns.Count)
'Duplicate the values over
rngTarget.Value = rngSource.Value
'Prepare the target range for the next loop
Set rngTarget = shtTarget.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
'Close the source file
wbkSource.Close False
Next iLoop
End Sub
By declaring and using variables throughout, the code should be easier both to write and to read. It should also run quicker, since it's using the range1.value = range2.value structure, which bypasses the rather slow clipboard. It also contains a check to make sure that you're not surpassing 1,048,576 rows of data, which would cause a crash.
quite along the lines of good coding practice Werff already explained to you, you could try this other (commented) code:
Sub Macro1()
Dim outputSht As Worksheet '<--| declare a variable to set your "output" sheet to
Dim countryData As Variant, countryNames As Variant '<--| declare arrays to store "country names" and "country data" in
Dim country As Variant '<-- "countries" looping variable
Application.Calculation = xlCalculationManual '<-- disable calculations
Application.ScreenUpdating = False '<-- disable screen updating
With Workbooks("Try").Worksheets("Names") '<--| reference "country names" worksheet
countryNames = Application.Transpose(.Range("A1", .Cells(.Rows.count, 1).End(xlUp)).Value) '<--| store country names in column "A" from row 1 down to last not empty row
End With
Set outputSht = Workbooks("Try").Worksheets("Output") '<--| set "output" worksheet
For Each country In countryNames '<-- loop through countries stored in 'countryNames'
With Workbooks.Open(FileName:="C:path\" & Country).Sheets("Main") '<--| open current country workbook and reference its "Main" sheet
countryData = .Range("BL1", .Cells(.Rows.count, 1).End(xlUp)).Value '<--| store current country data in 'countryData' array
.Parent.Close SaveChanges:=False '<--| close current country workbook
End With
With outputSht '<--| reference output sheet
With .Cells(.Rows.count, 1).End(xlUp).Offset(1).Resize(UBound(countryData, 1)) '<--|reference its column A range from first empty cell after last not empty cell down to as many rows as current country array has
.Value = country '<--| write current country name in referenced range
.Offset(, 1).Resize(, 64).Value = countryData '<--| write country data array content from column B rightwards
End With
End With
Next country
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
since it uses arrays to store data, it suffers from the arrays maximum size limitation to 65536 rows. If your "countries" workbooks "Main" sheets have more rows than such a limit then different pasting values techniques must be adopted (like between range values)
I have a range of data on Sheet2 that links it to Sheet1 (Sheet1 is formatted and linked by Sheet2 using =if(Sheet2$x$x="","",Sheet2$x$x); this way any data put into the range C13:G62 of Sheet2 shows up in Sheet1 range C13:G62. The beginning portion on the code works to move JUST the data in the specified range to the BATCH file Sheet3 and finds the last row pasting the values from Sheet1 without copying the formulas. It was made this way so I can delete data on Sheet2 to wipe Sheet1 clean but still have all the backup data on one Sheet3.
Anyway, the problem lies when I tried to manipulate the code to copy all contents on Sheet1 (to DUPLICATE SHEET1) to another sheet at the end of the workbook:
Sheets(Sheet1).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = _
InputBox("Name of the New WorkSheet")
This allowed me to name the sheet which was great. However by creating multiple variations of code it will not move the DATA in the RANGE to the newly created Sheet4 (there is no data). In one iteration of code I was able to get Sheet1 to copy and make Sheet4 at the end of the work book with no data in the range but have the cursor land in cell C13, the starting point for pasting just the values, and when I left click the mouse in that cell to "paste values" it would paste the values that I was trying to paste. However, either way I rearranged the code, the data would always be copied but would never paste to the Sheet4 range.
Here I have posted one variation of the code IN WHICH IT STILL WILL NOT PASTE THE VALUES TO SHEET4 (THE NEWLY CREATED SHEET) but still copies to the BATCH FILE. What am I missing here?
Dim s1Sheet As Worksheet
Dim s2Sheet As Worksheet
Dim source As String
Dim target As String
Dim rngSource As Range
Dim rngTargetStart As Range
source = "Invoice"
target = "TOTAL_INVOICE"
Application.EnableCancelKey = xlDisabled
Set s1Sheet = Sheets(source)
Set s2Sheet = Sheets(target)
Set rngSource = s1Sheet.Range("C13:G62")
Set rngTargetStart = s2Sheet.Range("C" & Rows.Count).End(xlUp).Offset(1)
'Set rngTargetFinish = ws1.Range("C" & Rows.Count).End(xlUp).Offset(1)
rngTargetStart.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
'rngTargetFinish.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
'Set target = Sheets("Sheet4").Range("B13:G63")
copy_non_formulas source:=rngSource, target:=rngTargetStart
' copy_non_formulas source:=Range("B13:G63"), target:=Range("B70:G109") Unhighlight
' copy_non_formulas source:=Range("B13:G63"), target:=Range("B13:G63") Unhighlight
'===Copies Sheet to End of WorkBook & Pastes Values======
Sheets(source).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = _
InputBox("Name of the New WorkSheet")
Range("C13:G62").ClearContents
Dim rng As Range
Set rng = ActiveSheet.Range("C13:G62")
rng.ClearContents
Dim s3Sheet As Worksheet
Dim rngTargetStart2 As Range
Set s3Sheet = Sheets(Sheets.Count)
Set rngTargetStart2 = s3Sheet.Range("C" & Rows.Count).End(xlUp).Offset(1)
rngTargetStart2.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
copy_non_formulas2 source:=rngSource, target2:=rngTargetStart2
copy_non_formulas2 source:=Range("C13:G62"), target2:=Range("C13:G62")
This is an Integrated Public Sub
copy_non_formulas(source As Range, target As Range)
Dim i As Long
Dim j As Long
Dim c As Range
For i = 1 To source.Rows.Count
For j = 1 To source.Columns.Count
Set c = source(RowIndex:=i, ColumnIndex:=j)
If Left(c.Formula, 1) <> "=" Then
target(RowIndex:=i, ColumnIndex:=j).Value = c.Value
End If
Next j
Next i
And another Public Sub for the Second Move
copy_non_formulas2(source As Range, target2 As Range)
Dim x As Long
Dim y As Long
Dim d As Range
For x = 1 To source.Rows.Count
For y = 1 To source.Columns.Count
Set d = source(RowIndex:=x, ColumnIndex:=y)
If Left(d.Formula, 1) <> "=" Then
target2(RowIndex:=x, ColumnIndex:=y).Value = d.Value
End If
Next y
Next x
I am able to copy the last row of one workbook and paste it after the last row of another workbook. I want to copy the entire data from row 2 (row 1 is header) in the first workbook and paste it after the last row of another workbook. Please advise me what changes are required in the code below to copy the entire data from row 2 instead of only the last row.
Dim lastS1Row As Long
Dim nextS2Row As Long
Dim lastCol As Long
Dim lCol As Long
Dim lCol1 As Long
Dim s1Sheet As Worksheet, s2Sheet As Worksheet
Dim source As String
Dim target As String
Dim path As String
Dim path1 As String
source = "Students" 'Source Worksheet Name
path1 = "H:\Shaikh_Gaus\scratch\VBA\Book17.xlsx"
path = "H:\Shaikh_Gaus\scratch\VBA\Book16.xlsx"
target = "Students" 'Target Worksheet Name
Application.EnableCancelKey = xlDisabled
Set s1Sheet = Workbooks.Open(path).Sheets(source)
Set s2Sheet = Workbooks.Open(path1).Sheets(target)
lastS1Row = s1Sheet.Range("A" & Rows.Count).End(xlUp).Row
nextS2Row = s2Sheet.Range("A" & Rows.Count).End(xlUp).Row + 1
lastCol = s1Sheet.Cells(1, Columns.Count).End(xlToLeft).Column
For lCol = 1 To lastCol
s2Sheet.Cells(nextS2Row, lCol) = s1Sheet.Cells(lastS1Row, lCol)
Next lCol
Next lCol1
s2Sheet.Activate
ActiveWorkbook.Close SaveChanges:=True
s1Sheet.Activate
ActiveWorkbook.Close
This adjusted version of your code should do the job:
Dim s1Sheet As Worksheet, s2Sheet As Worksheet
Dim source As String
Dim target As String
Dim path As String
Dim path1 As String
Dim rngSource As Range
Dim rngTargetStart As Range
source = "Students" 'Source Worksheet Name
path1 = "H:\Shaikh_Gaus\scratch\VBA\Book17.xlsx"
path = "H:\Shaikh_Gaus\scratch\VBA\Book16.xlsx"
target = "Students" 'Target Worksheet Name
Application.EnableCancelKey = xlDisabled
Set s1Sheet = Workbooks.Open(path).Sheets(source)
Set s2Sheet = Workbooks.Open(path1).Sheets(target)
Set rngSource = Range(s1Sheet.Range("A2"), s1Sheet.Cells.SpecialCells(xlCellTypeLastCell))
Set rngTargetStart = s2Sheet.Range("A" & Rows.Count).End(xlUp).Offset(1)
rngTargetStart.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
s2Sheet.Parent.Close SaveChanges:=True
s1Sheet.Parent.Close
I removed something what seemed unnecessary. The main thing is that now you don't loop through columns and rows. Now you can do it with one operation.
Avoid as much as you can things like .Select, .Activate. and .Copy if you just need values to be pasted. You can simply do something similar like I did:
Target.Value = Source.Value
After you set s1Sheet and s2Sheet I think you should be able to use these 2 lines to copy & paste the entire range at once:
'copy Cells A2 through last row and last column used
s1Sheet.Range(s1Sheet.Cells(2, 1), s1Sheet.Cells(s1Sheet.Cells(s1Sheet.Rows.Count, 1).End(xlUp).Row, _
s1Sheet.Cells(1, s1Sheet.Columns.Count).End(xlToLeft).Column)).Copy
'paste those cells in next blank row of second sheet
s2Sheet.Cells(s2Sheet.Cells(s2Sheet.Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteAll
'Here you go:
Range("A2").End(xlDown).select
selection.End(xlRight).select
selection.copy
'then active the next sheet for e.g Sheet2.Active
last_row = range("A1048576").end(xlup).row
range("A" & last_row).paste
' Done
I am having a problem to consolidate data from multiple worksheet into a summary worksheet. It is able to copy all the data except when the data is pasted it will overwrite the previous data. Example data in sheet A is pasted to recompile sheet starting from range A2. The problem is data in sheet B,C,D etc will also be pasted starting from range A2 causing it to overwrite each other.
This is my code.
Private Sub CommandButton2_Click()
Dim Sheetname, myrange As String
Dim A, noOfrows As Integer
Dim startRow As Integer
For i = 2 To Worksheets("Master Sheet").Cells.SpecialCells(xlCellTypeLastCell).Row
Sheetname = Worksheets("Master Sheet").Cells(i, 27).Value'All the sheets that suppose to transfer to recompile sheet
noOfrows = Worksheets(Sheetname).Cells.SpecialCells(xlCellTypeLastCell).Row
myrange = "A2:N" & CStr(noOfrows)
Worksheets(Sheetname).Select
Worksheets(Sheetname).Range(myrange).Select
Selection.Copy
Sheets("Recompile").Select
Range("A2").Select
ActiveSheet.Paste
Next i
End Sub
You need to find the UsedRange in the "Recompile" sheet and paste into the range below that:
Something like:
Private Sub CopyData()
Dim A As Long
Dim noOfrows As Long
Dim startRow As Long
Dim i As Long
Dim control As Worksheet
Dim source As Worksheet
Dim target As Worksheet
Set control = Worksheets("Master Sheet")
Set target = Worksheets.Add
For i = 2 To control.UsedRange.Rows.Count
' the target worksheet for this row of data
Set source = Worksheets(control.Cells(i, 1).Value) ' My example has this data in column A
' the address of a range with (number of rows - 1) for columns A:N
source.Range("A2:N" & source.UsedRange.Rows.Count).Copy
target.Range("A" & target.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row).PasteSpecial xlPasteValues
Next i
End Sub
Lots of information and tips here: http://www.rondebruin.nl/win/s3/win002.htm
I am attempting to first, find the the largest value in a column (C), then copy and paste that value into the next empty cell in 'Row 3' in a different (master) workbook. The macro I am running is found in the master workbook. I found this code that i believe will get the pasted cell into the correct spot, but I could use assistance in the code for how to find the largest cell in column C in the data workbook, and then copying and pasting that value.
Private Sub CommandButton1_Click()
Dim wsMaster As Worksheet, wbDATA As Workbook
Dim NextColumn As Long, LastRow As Long
Set wsMaster = ThisWorkbook.Sheets("Contract Metrics")
NextColumn = wsMaster.Range("C", 3).End(xlUp).Column + 1
Set wbDATA = Workbooks.Open("C:\Documents and Settings\Michael Palkovitz\My Documents\Test\Contracts Metrics.xlsx")
wbDATA.Close False
End Sub
Try this. First sort the column you need the value from, then get the last row and place the value into your first empty column in row 3 of your master sheet.
' Create an excel application and open the workbook containing the data
Dim app As Object
Dim wb As Object
Dim ws As Object
Set app = CreateObject("Excel.Application")
Set wb = app.Workbooks.Open("C:\Workbook1")
Set ws = wb.Sheets(1)
' Get last row with a value to use for the sort range
Dim last As Long
Dim value As Long
With ws
last = ws.Cells(ws.Rows.Count, 3).End(xlUp).row
.Range("C1:C" & last).Sort Key1:=.Range("C2"), order1:=xlAscending, Orientation:=xlTopToBottom
value = .Cells(last, 3)
End With
' Get the last filled cell and move over one to get the empty column
Dim col As Long
col = ActiveSheet.Cells(3, 1).End(xlToRight).Offset(0, 1).Column
ActiveSheet.Cells(3, col).value = value
wb.Close False
Set ws = Nothing
Set wb = Nothing
Set app = Nothing