Macro to create a list

[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

 

[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

 

[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

 

[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

 

[tomhelle]

Thank you so much Otto! That worked beautiful!!

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



.

 

[Otto Moehrbach]

You're welcome. Thanks for the feedback. Otto

Thank you so much Otto! That worked beautiful!!