echane
11-23-2009, 02:00 PM
Hi, I was trying to copy information (set up in rows) from one sheet to other worksheets but it's not working correctly. I'm mainly trying to get it to know to copy information from each row into the next empty column on the other sheets but right now it's just copying the same row of information into the next 20 or so columns. I think I messed up some looping thing.
Also, if information there are two rows of information that should be copied to another worksheet, they should each have their own column. Asides from the repeating problem, it also just starts over with the first column and overwrites the first row's information. Please let me know if there's something really wrong with my code. Thanks!
Public Sub Populate()
Const InputCol As String = "A"
Dim i As Long
Dim j As Long
Dim LastRow As Long
Dim LastCol As Long
Dim sh As Worksheet
Set sh = Sheet4
With sh
LastRow = .Cells(.Rows.Count, InputCol).End(xlUp).Row
LastCol = ActiveSheet.Cells(4, ActiveSheet.Columns.Count).End(xlToLeft).Column
For i = 7 To LastRow
For j = 2 To LastCol
.Cells(i, "A").Copy
Sheets(.Cells(i, "A").Value).Select
ActiveSheet.Cells(3, j).PasteSpecial Paste:=xlPasteValues
.Cells(i, "B").Copy
Sheets(.Cells(i, "A").Value).Select
ActiveSheet.Cells(4, j).PasteSpecial Paste:=xlPasteValues
Next j
Next i
End With
End Sub
Also, if information there are two rows of information that should be copied to another worksheet, they should each have their own column. Asides from the repeating problem, it also just starts over with the first column and overwrites the first row's information. Please let me know if there's something really wrong with my code. Thanks!
Public Sub Populate()
Const InputCol As String = "A"
Dim i As Long
Dim j As Long
Dim LastRow As Long
Dim LastCol As Long
Dim sh As Worksheet
Set sh = Sheet4
With sh
LastRow = .Cells(.Rows.Count, InputCol).End(xlUp).Row
LastCol = ActiveSheet.Cells(4, ActiveSheet.Columns.Count).End(xlToLeft).Column
For i = 7 To LastRow
For j = 2 To LastCol
.Cells(i, "A").Copy
Sheets(.Cells(i, "A").Value).Select
ActiveSheet.Cells(3, j).PasteSpecial Paste:=xlPasteValues
.Cells(i, "B").Copy
Sheets(.Cells(i, "A").Value).Select
ActiveSheet.Cells(4, j).PasteSpecial Paste:=xlPasteValues
Next j
Next i
End With
End Sub