Transposing cells & deleting sheets

[Andrew]

Ladies & Gents,

I have a few problems with a macro, which I was hoping to find an answer
from this newsgroup.

My first problem is that I wish to copy a series of cells which are part of
a column in a spreadsheet, then transpose them to another sheet so that they
apear in one row. I then want to copy the next series of cells in the same
column of the first sheet, and transpose them into the next row of the
second sheet. Each series, which contain 7 cells, starts at a point I have
called "Currentcell", and will be transposed from the "Datacell". I have
most of the code figured out, and listed it below. The Datacells change
each time the loop is used, but I cannot figure out how to make the current
cell start from a new position. This can be seen on the line reading
"Range("A1:A7").Select". Can someone please tell me how to select the next
7 cells in a column starting from a new Currentcell each time the loop is
started?

Set Currentcell = Worksheets(3).Range("A1")
Set Datacell = Worksheets("File").Range("A1")

Do While Not IsEmpty(Currentcell.Value)

If Left(Currentcell.Value, 6) = "Record" Then
Range("A1:A7").Select ' This is the incorrect code
Selection.Copy
Sheets("File").Select
Datacell.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
True, Transpose:=True
Set Datacell = Datacell.Offset(1, 0)
Datacell.Select ' I've left this code in
durnig testing to see that it works. It does.
ActiveSheet.Next.Select
End If

Set Currentcell = Currentcell.Offset(7, 0)
Currentcell.Select

Loop

My second problem is that I am opening files, copying them, processing them
in the macro, then deleting them. I'm doing this to save time & space.
Unfortunately, when I delete the unwanted sheets, I receive a message box
saying "The selected sheets will be permanently deleted. Do you want to
continue? OK - Cancel". This warning appears for each sheet which is
deleted. How do I delete a sheet and stop that message from appearing?


Many Thanks In Advance
Andrew

 

[Ron de Bruin]

Hi Andrew

Below you find a example that tranpose the cell in column A of the activesheet to Sheet2 in blocks of 7 cells
You can use this in your macro

Sub test()
Dim a As Long
Dim b As Long
Dim Rng As Range
Dim dest As Range
For a = 1 To ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row Step 7

Set Rng = ActiveSheet.Range(Cells(a, 1), Cells(a + 6, 1))
Set dest = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
Set dest = dest.Resize(Rng.Columns.Count, Rng.Rows.Count)
dest.Value = Application.Transpose(Rng)
Next
End Sub


For deleting sheets use this

Sub test2()
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End Sub

 

[Andrew]

Ron,

Many thanks. I'll give it a go tonight. I'll be sure to have a look at
your site before hand.


Thanks again
Andrew

Hi Andrew

Below you find a example that tranpose the cell in column A of the

activesheet to Sheet2 in blocks of 7 cells

 

[chasbot]

I'm having a similar problem. I basically want to use the same cod
that you provided to Andrew, but I only want the data in column "H
transposed. I tried to change the code w/ several variations w/ou
success.

Any help you could provide would be appreciated.

Charle