Copying used range from other sheets ignoring row 1

[Andy]

Hiya,

I have been using the below code for a while and it works perfectly
but I am currently trying to refine it for other projects and am
struggling...

The only part missing is the ability to choose exactly which rows have
data in them and only transfer those. I have managed to do this in
various different ways but I need it to ignore each header row (row
1), as some of the data sources have only a couple of lines of data
with a heading. I have found different ways of doing it that don't
seem to work with my below code.

Private Sub cmdImport2_Click()
On Error GoTo Err_CommandButton1_Click

Application.DisplayAlerts = False
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim i As Long
Dim a As Long
Dim s$
Dim rng As Range

Application.ScreenUpdating = False

With Application.FileSearch
.NewSearch
.LookIn = InputBox("Please amend the folder name as
appropriate using the following format as an example" & Chr(13) &
Chr(13) & "F:\APRD SHARED FOLDER\STATS", "Enter File Path", "")
.FileName = "*Maritime*.xls"
.MatchTextExactly = False


.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set basebook = ThisWorkbook
rnum = 2
For i = 1 To .FoundFiles.Count

Set mybook = Workbooks.Open(.FoundFiles(i))
Application.AskToUpdateLinks = False

Err.Clear
On Error Resume Next

Set sourceRange = Sheets("Data").Range("A2:BP50")
a = sourceRange.Rows.Count

If Err <> 0 Then
'Sheets("Data") doesn't exist
Set sourceRange = Sheets("Other Data").Row("2:50")
a = sourceRange.Rows.Count
Set sourceRange = Sheets("Insert other tab name
here").Range("a2:k336")
a = sourceRange.Rows.Count
a = sourceRange.Rows.Count
Set sourceRange = Sheets("Insert other tab name
here2").Range("a2:k336")
a = sourceRange.Rows.Count
End If
On Error GoTo 0
Err.Clear

With sourceRange

Set destrange = basebook.Worksheets(2).Cells(rnum,
1). _
Resize(.Rows.Count, .Columns.Count)

End With
destrange.Value = sourceRange.Value
mybook.Close SaveChanges:=False
rnum = i * a + 1
Next i
End If
End With

Application.ScreenUpdating = True

Exit_CommandButton1_Click:
Exit Sub

Err_CommandButton1_Click:
'MsgBox Err.Description
Resume Exit_CommandButton1_Click
End Sub

 

[AB]

You might need to rephrase your question - so:
- what exactly that is you're trying to achieve?
- what exactly that is that's failing? I gather that not all of your
code is faulty, so what exactly that is that's not happening?

Perhaps one could figure the above out from your code but the code is
quite 'specific' (for a lack of a better word) and with loads of
haredcoded stuff - so, It's not easy for people here spot the sole
fault you're interested in fixing.

 

[Andy]

Thanks for the reply.

The code itself currently works like this:

Opens each workbook with "Maritime" in the filename and copies a
certain range from that workbook, pasting it into the main workbook
(basebook)
The next workbook pastes underneath the previous one and so on.

At the moment however since the workbook copies the range A2:BP50 and
sometimes workbooks only contain between 1 and 5 rows I would like to
cut out the other 45-49 rows to eliminate blank rows on the main
workbook.

I have tried various solutions to copy only the rows with data present
but unfortunately I have not found a way to leave out the header row
when copying the data.

So in short, I need to change the below code to only copy the used
rows only, exluding row 1:

Set sourceRange = Sheets("Data").Range("A2:BP50")
a = sourceRange.Rows.Count

I hope this is clearer - thanks for your time!

 

[AB]

I guess the bit that confuses me is that this:
Sheets("Data").Range("A2:BP50")
already exludes 1st row...
Anways - is there a specific column that would define whether the row
is to be copied or not, for instance, would you want the row to be
copied only if cell in collumn A for that row is not empty? So, what's
the simplest/exact criteria for the row to go from source to
destination?

 

[Jim Rech]

This is one way to copy the used range of the active sheet from A2:

Sub CopyUsedRgFromA2()
Dim LastCell As Range
Set LastCell = Cells.SpecialCells(xlCellTypeLastCell)
If LastCell.Row > 1 Then
Range("A2", LastCell).Copy
''Do paste
End If
End Sub

 

[Andy]

What I was trying to explain is that the section needs to be
completely changed because it doesn't check which rows have data in...

I don't want it to be A2:BP50, I want it to be A2:BP(whichever the
last row with data in is)

It's as simple as that. There will be blank cells in different rows so
even if the last row in the source workbook only has data in cell G7 I
still want that whole row copied over.

 

[Andy]

Column A will always be filled in so if there is a way to base which
rows are copied on whether data is present then that would be a good
workaround!

 

[AB]

How about this then:

Sub CopyData()
Dim sourceRange As Range
Dim MyBook As Workbook
Dim baseBook As Workbook
Dim lastRow As Long

Set MyBook = ThisWorkbook '<-- change to your needs - the looped
variable.
Set baseBook = ThisWorkbook '<-- change to your needs - where you
define the base book.

'Define the SourceRange
With MyBook.Worksheets("Data")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
'Now you know where the list (to be copied) ends
Set sourceRange = .Range("A2", "A" & lastRow).EntireRow'Sets
the range to copy.
'I grabbed the entire row - adjust if necessary.
End With

'Define where to put the source values
With baseBook.Worksheets(2)
'Establish the last used row in the target ws
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
'Copy the whole lot over starting from row that's =lastRow + 1
sourceRange.Copy Destination:=.Cells(lastRow + 1, "A")
End With
End Sub

 

[Andy]

Thanks.

I've played around with your code but am getting "Subscript out of
range" errors.

I needed to add your code to part of mine to allow the user to select
the folder and because I need it to copy only from certain files:
I'll keep playing around with it, I must be missing something...

Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim i As Long
Dim lastRow As Long

Application.ScreenUpdating = False

With Application.FileSearch
.NewSearch
.LookIn = InputBox("Please amend the folder name as
appropriate using the following format as an example" & Chr(13) &
Chr(13) & "F:\APRD SHARED FOLDER\Performance", "Enter File Path", "")
.FileName = "*Maritime*.xls"
.MatchTextExactly = False


.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set basebook = ThisWorkbook
rnum = 2

Set mybook = Workbooks.Open(.FoundFiles(i))
Application.AskToUpdateLinks = False
End If

End With

'Define the SourceRange
With mybook.Worksheets("Data")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
'Now you know where the list (to be copied) ends
Set sourceRange = .Range("A2", "A" & lastRow).EntireRow
'Setsthe range to copy.
'I grabbed the entire row - adjust if necessary.
End With


'Define where to put the source values
With basebook.Worksheets("Marine")
'Establish the last used row in the target ws
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
'Copy the whole lot over starting from row that's =lastRow + 1
sourceRange.Copy Destination:=.Cells(lastRow + 1, "A")
End With

End Sub

 

[AB]

What line of code gets highlighted in yellow when the error fires?

 

[AB]

Unless i missed something, you seem to have dropped the:

For i = 1 To .FoundFiles.Count
....
next i

bit, and then when this:
Set mybook = Workbooks.Open(.FoundFiles(i))
tries to run - it it must be firing the error.
If so = get the for next loop back in there and try then.

 

[Andy]

Yep - Silly mistake by me!

Everything appears to work now - Thanks a lot for your time and
patience!

 

[AB]

That's why people are here!
Glad i could help and thanks for the feedback!