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

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.

On Oct 1, 11:08*am, Andy <andyr...@hotmail.co.uk> wrote:
> 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

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!

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?

On Oct 1, 12:16*pm, Andy <andyr...@hotmail.co.uk> wrote:
> 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!

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" <(E-Mail Removed)> wrote in message
news:2fa320e3-0857-40e4-973d-(E-Mail Removed)...
> 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!

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.

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!

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


On Oct 1, 12:58*pm, Andy <andyr...@hotmail.co.uk> wrote:
> 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!

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

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