Copy & Paste Question

M

Mark

Hi,
I’m trying to copy and paste data between sheets in a workbook and I’m not
sure what the proper coding is to make it work correctly, so I’m looking for
some help. For now, it will always be columns A & B that get copied from
sheet 1 to sheet 2, but the number of rows being copied from sheet 1 will
always vary and may have data through column Z. The workbook is being created
from a template, which has a header down through row 12 and has a footer
after inserting the rows on sheet 2. The code I’m using is attached below and
it does work, but I don’t think that it’s the proper way to perform the
operation. Can anyone help me?
Thanks,
Mark


Sub CommandButton1_Click()
Dim RowNdx As Long
Dim ColNdx As Integer
Dim SaveColNdx As Integer
Dim wkbk As ThisWorkbook
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ColNdx = 1
RowNdx = 13

For X = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(X) = True Then
Cells(RowNdx + 1, ColNdx).EntireRow.Insert
Rows(RowNdx).Copy
Rows(RowNdx + 1).PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
Cells(lastrow + 1, ColNdx).Select
' display the Selected item.
Cells(RowNdx, ColNdx).Value = ListBox1.List(X)
If Worksheets(1).Name <> "Fall" Then

For t = 2 To ActiveWorkbook.ActiveSheet.UsedRange.Columns.Count
With Cells(RowNdx, t)
.Formula = "=vlookup(" & Cells(RowNdx, ColNdx).address _
& ",'" & studentPath & "[" & studentFile & "]" & grade &
"'!A:Z," & t & ", 0)"
.Value = .Value
End With
Next t
With Worksheets(2)
.Cells(RowNdx, ColNdx).EntireRow.Copy
.Cells(RowNdx + 1, ColNdx).EntireRow.Insert
.Cells(RowNdx + 1, ColNdx).EntireRow.PasteSpecial Paste:=xlFormats

===> It’s these next two lines that work, but doesn’t look like good coding
technique
.Cells(RowNdx, ColNdx).Value = Worksheets(1).Cells(RowNdx,
ColNdx).Value
.Cells(RowNdx, ColNdx + 1).Value = Worksheets(1).Cells(RowNdx,
ColNdx + 1).Value
Application.CutCopyMode = False
.Cells(RowNdx, ColNdx).Value = ListBox1.List(X)
End With

End If
RowNdx = RowNdx + 1
End If
Next X
If Worksheets(1).Name <> "Fall" Then
Rows(RowNdx).Delete Shift:=xlUp
End If
Worksheets(2).Rows(RowNdx).Delete Shift:=xlUp
'Worksheets(2).Cells(RowNdx, ColNdx + 2).Select
'End If
Unload Me
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
 

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