Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Discussion (Misc queries) > Excel 2003 + export of data
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 163
Default 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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 11,501
Default 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
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 163
Default 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
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 11,501
Default 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
Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 163
Default 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
Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 11,501
Default 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
Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 163
Default 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
Reply With QuoteReply With Quote
  #8   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 11,501
Default 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
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Can I use & export data & sheets between Excel 2003 & 2007 SDinSD Excel Discussion (Misc queries) 3 January 5th 10 10:59 PM
SAP export to Excel 2003 Lance Hebert[_2_] Excel Discussion (Misc queries) 1 January 28th 09 11:16 PM
EXCEL 2003 Export Issue wendyw Excel Worksheet Functions 1 June 30th 08 06:26 PM
Export to Excel 2003 from Oracle Discoverer 9i somethingwrong Excel Discussion (Misc queries) 0 May 15th 07 04:27 PM
How can I export an excel 2003 chart to a .jpg? Jason Krause Charts and Charting in Excel 3 August 18th 05 10:39 PM


All times are GMT +1. The time now is 05:01 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement