PDA

View Full Version : Copy Range Until Last Cell With Data



sharc316
03-26-2017, 06:30 PM
Hi, I have some code below that consolidates my workbooks and worksheets. The line below in bold (myWS.Range("A2:Z100").Copy) selects a range from each worksheet and pastes it in the master file. I would like this to copy until the last cell of data since the rows are different with each file. Currently it's defined at row 100.

Any help with be apprecited. Thank you.



Option Explicit

Sub ConsolidateDataKarpExprs()
'
Dim MyPath As String
Dim SumPath As String
Dim MyName As String
Dim SumName As String
Dim MyTemplate As String
Dim SumTemplate As String
Dim myWS As Worksheet
Dim sumWS As Worksheet
Dim Last_Row As Long

'Define folders and filenames
MyPath = "C:\Users\Kate\Desktop\FedEx Reporting\Karpathian Express Test\"
SumPath = "C:\Users\Kate\Desktop\FedEx Reporting\"
MyTemplate = "*.xls" 'Set the template.
SumTemplate = "Karpathian Express Master.xlsm"

'Open the template file and get the Worksheet to put the data into
SumName = Dir(SumPath & SumTemplate)
Workbooks.Open SumPath & SumName

Set sumWS = ActiveWorkbook.Worksheets("Linehaul Trips")
'Open each source file, copying the data from each into the template file
MyName = Dir(MyPath & MyTemplate) 'Retrieve the first file
Do While MyName <> ""
'Open the source file and get the worksheet with the data we want.
Workbooks.Open MyPath & MyName
Set myWS = ActiveWorkbook.Worksheets("Linehaul Trips")
'Copy the data from the source and paste at the end of Summary sheet
myWS.Range("A2:Z100").Copy
sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
'Close the current sourcefile and get the next
Workbooks(MyName).Close SaveChanges:=False 'close
MyName = Dir 'Get next file
Loop

Set sumWS = ActiveWorkbook.Worksheets("Other Settlements Adjustments")
'Open each source file, copying the data from each into the template file
MyName = Dir(MyPath & MyTemplate) 'Retrieve the first file
Do While MyName <> ""
'Open the source file and get the worksheet with the data we want.
Workbooks.Open MyPath & MyName
Set myWS = ActiveWorkbook.Worksheets("Other Settlements Adjustments")
'Copy the data from the source and paste at the end of Summary sheet
myWS.Range("A2:Z106").Copy
sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
'Close the current sourcefile and get the next
Workbooks(MyName).Close SaveChanges:=False 'close
MyName = Dir 'Get next file
Loop



'Now all sourcefiles are copied into the Template file. Close and save it
'Workbooks(SumName).Close SaveChanges:=True
End Sub

Paul_Hossler
03-26-2017, 06:57 PM
Please use CODE tags with your macro(s) between them

Click the [#] icon and put your code between the
..... tags

It makes it easier to read and to see your code

Paul_Hossler
03-26-2017, 07:03 PM
Not tested (or even syntax checked) but instead of ...



myWS.Range("A2:Z100").Copy



... try something like this



Set rTemp = Intersect (myWS.Range("A:Z"), myWS.UsedRange)
Set rTemp = rTemp.Cells(2,1).resize (rTemp.Rows.Count-1, rTemp.Columns.Count).Copy

sharc316
03-27-2017, 04:41 AM
Thanks Paul. What would I define rTemp as?

(and noted regarding posting macro between code tags, will do so in future posts)

Paul_Hossler
03-27-2017, 07:12 AM
Thanks Paul. What would I define rTemp as?

Dim rTemp As Range

There's probably a way to do it all on one line and/or without Dim-ing a temp Range variable, but that (wordy) style is just the way I do it

So if you've used a WS and the last/lowest cell was AC123

1. The first statement makes rTemp = the intersection of A1:AC123 and A:Z, or = A1:Z123 (which has 123 rows and 26 columns)

2. The next statement resizes the above rTemp starting in A2 for 122 rows and 26 columns or A2:Z123

BTW, if there is no data past (say) row 50 in columns A:Z, it'll still copy the empty rows

If that's a problem, there are more 'accurate' but more complicated ways to just copy something like A2:A36, B2:B45, C2:C19, ...., Z2:Z50