ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Excel 2003 + export of data (https://www.excelbanter.com/excel-discussion-misc-queries/257458-excel-2003-export-data.html)

Neil Holden
Excel 2003 + export of data
 
Hi all Gurus, below is the code to export a worksheet to another excel
workbook when a button is pressed. This works perfect, however ideally i
want it to paste in the values and not the formatting and/or formulas etc
(just the figures)

Please Help.

Neil.

Sub Button2_Click()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet, lngRow As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("\\sguk-app1\Business Objects\CHR\Export of
SGUK.xls")
Set ws = wb2.Sheets("Sheet1")

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy ws.Range("A" & lngRow)
wb2.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

Mike H
Excel 2003 + export of data
 
Hi,

Try this

Private Sub CommandButton1_Click()
Sub Button2_Click()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet, lngRow As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook

Set wb2 = Workbooks.Open("\\sguk-app1\Business Objects\CHR\Export of
SGUK.xls ")
Set ws = wb2.Sheets("Sheet1")

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Neil Holden" wrote:

Hi all Gurus, below is the code to export a worksheet to another excel
workbook when a button is pressed. This works perfect, however ideally i
want it to paste in the values and not the formatting and/or formulas etc
(just the figures)

Please Help.

Neil.

Sub Button2_Click()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet, lngRow As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("\\sguk-app1\Business Objects\CHR\Export of
SGUK.xls")
Set ws = wb2.Sheets("Sheet1")

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy ws.Range("A" & lngRow)
wb2.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

Neil Holden
Excel 2003 + export of data
 
Thanks Mike, I have adapted it to suit all the sheets i need to copy:

However it is throwing an error for lngRow = ws.Cells(Rows.Count,
"A").End(xlUp).Row on the second excel sheet to copy in the code, also the
data it copies to the external sheet its starting on row 1, i need it to
start pasting on row 2?

Sorry to be a pain.

Neil.


Sub Button2_Click()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet, lngRow As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("\\sguk-app1\Business Objects\CHR\Export of
SGUK.xls")
Set ws = wb2.Sheets("Sheet1")

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ETM409").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM450").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM451").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESS453").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM454").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM479").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESH492").Range("A8:U27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

'lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'wb1.Sheets("EGEC524").Range("A8:T27").Copy
'ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
'wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP528").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP532").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM543").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("MPC549").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP550").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM582").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC596").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP602").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM605").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC613").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM632").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

wb2.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Mike H
Excel 2003 + export of data
 
Neil

The mistake you making is closing wb2. here are your first 2 copy/paste
routines

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True '< You close here so delete this line

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ETM409").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues 'The try to read
wb2.Close True


Note you close wb2 and save it then go into you second paste routine and try
and get the last row to get the cell to paste into but because the book is
closed it falls over.

Answer= leave wb2 open until you've finished

Now you also have another issue with this line

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

For your first paste it will return 1 so data will paste into A1 and your
pasting 20 rows. But on the second paste that same line returns 20 so you
will overwrite the last row of your previous set of data so modify the line
to this

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row+1

the will prevent overwriting your data and solve the problem over starting
in row 1.

Hope this helps
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Neil Holden" wrote:

Thanks Mike, I have adapted it to suit all the sheets i need to copy:

However it is throwing an error for lngRow = ws.Cells(Rows.Count,
"A").End(xlUp).Row on the second excel sheet to copy in the code, also the
data it copies to the external sheet its starting on row 1, i need it to
start pasting on row 2?

Sorry to be a pain.

Neil.


Sub Button2_Click()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet, lngRow As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("\\sguk-app1\Business Objects\CHR\Export of
SGUK.xls")
Set ws = wb2.Sheets("Sheet1")

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ETM409").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM450").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM451").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESS453").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM454").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM479").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESH492").Range("A8:U27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

'lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'wb1.Sheets("EGEC524").Range("A8:T27").Copy
'ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
'wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP528").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP532").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM543").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("MPC549").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP550").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM582").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC596").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP602").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM605").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC613").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM632").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

wb2.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Neil Holden
Excel 2003 + export of data
 
Hi Mike, i'm disappointed in myself for not knowing that one!! Thanks very
much for your help, that is brilliant.

It works perfect now.

Take Care.

Neil.

"Mike H" wrote:

Neil

The mistake you making is closing wb2. here are your first 2 copy/paste
routines

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True '< You close here so delete this line

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ETM409").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues 'The try to read
wb2.Close True


Note you close wb2 and save it then go into you second paste routine and try
and get the last row to get the cell to paste into but because the book is
closed it falls over.

Answer= leave wb2 open until you've finished

Now you also have another issue with this line

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

For your first paste it will return 1 so data will paste into A1 and your
pasting 20 rows. But on the second paste that same line returns 20 so you
will overwrite the last row of your previous set of data so modify the line
to this

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row+1

the will prevent overwriting your data and solve the problem over starting
in row 1.

Hope this helps
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Neil Holden" wrote:

Thanks Mike, I have adapted it to suit all the sheets i need to copy:

However it is throwing an error for lngRow = ws.Cells(Rows.Count,
"A").End(xlUp).Row on the second excel sheet to copy in the code, also the
data it copies to the external sheet its starting on row 1, i need it to
start pasting on row 2?

Sorry to be a pain.

Neil.


Sub Button2_Click()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet, lngRow As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("\\sguk-app1\Business Objects\CHR\Export of
SGUK.xls")
Set ws = wb2.Sheets("Sheet1")

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ETM409").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM450").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM451").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESS453").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM454").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM479").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESH492").Range("A8:U27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

'lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'wb1.Sheets("EGEC524").Range("A8:T27").Copy
'ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
'wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP528").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP532").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM543").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("MPC549").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP550").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM582").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC596").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP602").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM605").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC613").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM632").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

wb2.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Mike H
Excel 2003 + export of data
 
Glad I could help and thanks for the feedback
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Neil Holden" wrote:

Hi Mike, i'm disappointed in myself for not knowing that one!! Thanks very
much for your help, that is brilliant.

It works perfect now.

Take Care.

Neil.

"Mike H" wrote:

Neil

The mistake you making is closing wb2. here are your first 2 copy/paste
routines

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True '< You close here so delete this line

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ETM409").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues 'The try to read
wb2.Close True


Note you close wb2 and save it then go into you second paste routine and try
and get the last row to get the cell to paste into but because the book is
closed it falls over.

Answer= leave wb2 open until you've finished

Now you also have another issue with this line

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

For your first paste it will return 1 so data will paste into A1 and your
pasting 20 rows. But on the second paste that same line returns 20 so you
will overwrite the last row of your previous set of data so modify the line
to this

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row+1

the will prevent overwriting your data and solve the problem over starting
in row 1.

Hope this helps
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Neil Holden" wrote:

Thanks Mike, I have adapted it to suit all the sheets i need to copy:

However it is throwing an error for lngRow = ws.Cells(Rows.Count,
"A").End(xlUp).Row on the second excel sheet to copy in the code, also the
data it copies to the external sheet its starting on row 1, i need it to
start pasting on row 2?

Sorry to be a pain.

Neil.


Sub Button2_Click()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet, lngRow As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("\\sguk-app1\Business Objects\CHR\Export of
SGUK.xls")
Set ws = wb2.Sheets("Sheet1")

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ETM409").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM450").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM451").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESS453").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM454").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM479").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESH492").Range("A8:U27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

'lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'wb1.Sheets("EGEC524").Range("A8:T27").Copy
'ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
'wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP528").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP532").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM543").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("MPC549").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP550").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM582").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC596").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP602").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM605").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC613").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM632").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

wb2.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Neil Holden
Excel 2003 + export of data
 
If i would like it to overight the current data in the external sheet
everytime the button is pressed would that be a big change?

"Mike H" wrote:

Glad I could help and thanks for the feedback
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Neil Holden" wrote:

Hi Mike, i'm disappointed in myself for not knowing that one!! Thanks very
much for your help, that is brilliant.

It works perfect now.

Take Care.

Neil.

"Mike H" wrote:

Neil

The mistake you making is closing wb2. here are your first 2 copy/paste
routines

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True '< You close here so delete this line

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ETM409").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues 'The try to read
wb2.Close True


Note you close wb2 and save it then go into you second paste routine and try
and get the last row to get the cell to paste into but because the book is
closed it falls over.

Answer= leave wb2 open until you've finished

Now you also have another issue with this line

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

For your first paste it will return 1 so data will paste into A1 and your
pasting 20 rows. But on the second paste that same line returns 20 so you
will overwrite the last row of your previous set of data so modify the line
to this

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row+1

the will prevent overwriting your data and solve the problem over starting
in row 1.

Hope this helps
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Neil Holden" wrote:

Thanks Mike, I have adapted it to suit all the sheets i need to copy:

However it is throwing an error for lngRow = ws.Cells(Rows.Count,
"A").End(xlUp).Row on the second excel sheet to copy in the code, also the
data it copies to the external sheet its starting on row 1, i need it to
start pasting on row 2?

Sorry to be a pain.

Neil.


Sub Button2_Click()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet, lngRow As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("\\sguk-app1\Business Objects\CHR\Export of
SGUK.xls")
Set ws = wb2.Sheets("Sheet1")

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ETM409").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM450").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM451").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESS453").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM454").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM479").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESH492").Range("A8:U27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

'lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'wb1.Sheets("EGEC524").Range("A8:T27").Copy
'ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
'wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP528").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP532").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM543").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("MPC549").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP550").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM582").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC596").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP602").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM605").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC613").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM632").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

wb2.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Mike H
Excel 2003 + export of data
 
If i would like it to overight the current data in the external sheet
everytime the button is pressed would that be a big change?

No very simple. Here are 2 lines from the start of your code to which I've
added a third which clears out the old data on each run

Set wb2 = Workbooks.Open("\\sguk-app1\Business Objects\CHR\Export of
SGUK.xls ")
Set ws = wb2.Sheets("Sheet1")
ws.Cells.ClearContents

You can even put that line inside a question IF statement

response = MsgBox("Do you want to clearcontents Y/N?", vbYesNo)
If response = vbYes Then
ws.Cells.ClearContents
End If


--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Neil Holden" wrote:

If i would like it to overight the current data in the external sheet
everytime the button is pressed would that be a big change?

"Mike H" wrote:

Glad I could help and thanks for the feedback
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Neil Holden" wrote:

Hi Mike, i'm disappointed in myself for not knowing that one!! Thanks very
much for your help, that is brilliant.

It works perfect now.

Take Care.

Neil.

"Mike H" wrote:

Neil

The mistake you making is closing wb2. here are your first 2 copy/paste
routines

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True '< You close here so delete this line

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ETM409").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues 'The try to read
wb2.Close True


Note you close wb2 and save it then go into you second paste routine and try
and get the last row to get the cell to paste into but because the book is
closed it falls over.

Answer= leave wb2 open until you've finished

Now you also have another issue with this line

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

For your first paste it will return 1 so data will paste into A1 and your
pasting 20 rows. But on the second paste that same line returns 20 so you
will overwrite the last row of your previous set of data so modify the line
to this

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row+1

the will prevent overwriting your data and solve the problem over starting
in row 1.

Hope this helps
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Neil Holden" wrote:

Thanks Mike, I have adapted it to suit all the sheets i need to copy:

However it is throwing an error for lngRow = ws.Cells(Rows.Count,
"A").End(xlUp).Row on the second excel sheet to copy in the code, also the
data it copies to the external sheet its starting on row 1, i need it to
start pasting on row 2?

Sorry to be a pain.

Neil.


Sub Button2_Click()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet, lngRow As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("\\sguk-app1\Business Objects\CHR\Export of
SGUK.xls")
Set ws = wb2.Sheets("Sheet1")

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ETM409").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM450").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM451").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESS453").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM454").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM479").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESH492").Range("A8:U27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

'lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'wb1.Sheets("EGEC524").Range("A8:T27").Copy
'ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
'wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP528").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP532").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM543").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("MPC549").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP550").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM582").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC596").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP602").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM605").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC613").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM632").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True

wb2.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub


All times are GMT +1. The time now is 05:52 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com