Macro to create a list


T

tomhelle

I have a workbook containing a worksheet called “List†and many worksheet
templates. I need a macro to select cells A1:H100 on any of the worksheet
templates, copy all data within this range but only if A1:A100 is not blank,
and then paste the data on the worksheet called “Listâ€. I’ll use a button to
activate the macro on each individual worksheet template. When the user
activates the macro on the first template, the data will be copied and pasted
to the “List†starting at cell A1. When the user activates the macro on any
of the subsequent templates, the data will copied and pasted on the “listâ€
starting at the next empty row in column A. In other words, I want the user
to be able to add data to the list from any of the templates.

I don’t have much experience with vba therefore, any help for a novice to
apply this would be greatly appreciated.

Thanks in advance,

Tom
 
Ad

Advertisements

O

Otto Moehrbach

Try this. Post back if you need more. HTH Otto
Sub CopyData()
Dim Dest As Range
If Application.CountA(Range("A1:A100")) > 0 Then
With Sheets("List")
Set Dest = .Range("A" & Rows.Count).End(xlUp).Offset(1)
Range("A1:H100").Copy Dest
End With
End If
End Sub
 
T

tomhelle

Hi Otto,

This is going to work GREAT but I forgot to mention that it needs to paste
as "paste special values". That way, I can get the raw data without any
formats, etc.

Thanks so much for your help!

Tom
 
O

Otto Moehrbach

Try this. HTH Otto
Sub CopyData()
Dim Dest As Range
If Application.CountA(Range("A1:A100")) > 0 Then
Application.ScreenUpdating = False
With Sheets("List")
Set Dest = .Range("A" & Rows.Count).End(xlUp).Offset(1)
Range("A1:H100").Copy
Dest.PasteSpecial xlPasteValues
End With
Application.ScreenUpdating = True
End If
End Sub
 
T

tomhelle

Thank you so much Otto! That worked beautiful!!

Otto Moehrbach said:
Try this. HTH Otto
Sub CopyData()
Dim Dest As Range
If Application.CountA(Range("A1:A100")) > 0 Then
Application.ScreenUpdating = False
With Sheets("List")
Set Dest = .Range("A" & Rows.Count).End(xlUp).Offset(1)
Range("A1:H100").Copy
Dest.PasteSpecial xlPasteValues
End With
Application.ScreenUpdating = True
End If
End Sub



.
 
Ad

Advertisements

Ad

Advertisements


Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top