PDA

View Full Version : Copying from one sheet to another



alliejane
09-18-2007, 07:49 AM
I am having a bear of a time trying to get what I want to work.

I have a spreadsheet that looks like a table. I need to change the format of it to something easier to put into a database.

I'm attaching a doc that shows what the table looks like and how I want it to look. I'm embarrassed to send any of my keystroke macros that I've tried because they are so ugly and just not working properly.

If someone could please give me a suggestion as to how to do what I want to do, I'd greatly appreciate it!

Bob Phillips
09-18-2007, 08:14 AM
Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Const START_ROW As Long = 7 '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim iLastCol As Long
Dim iNumRows As Long
Dim iNumCols As Long
Dim iRow As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
iLastCol = .Cells(START_ROW - 1, .Columns.Count).End(xlToLeft).Column
iNumCols = iLastCol - 1
iNumRows = iLastRow - START_ROW + 1
iRow = 1
For i = 1 To iNumCols
.Cells(START_ROW, TEST_COLUMN).Resize(iNumRows).Copy _
Worksheets("Sheet2").Range("A" & iRow)
Worksheets("Sheet2").Range("B" & iRow).Resize(iNumRows).Value = _
.Cells(START_ROW - 1, i + 1)
.Cells(START_ROW, i + 1).Resize(iNumRows).Copy _
Worksheets("Sheet2").Range("C" & iRow)
iRow = iRow + iNumRows
Next i
End With

End Sub