Macro to Copy and Paste Solved/Closed

Question

Hello,  

I would greatly appreciate any assistance with creating an Excel macro that will copy information from cells A1, B11:D11, A13, B23:D23, etc... and paste that information to cells J1, K1:N1.  Example: 

A1 would be the team name 
A2 thru A10 would be the list of players 
B1 would be January  
C1 would be February  
D1 would be March  
B2 thru D10 would be scores 
A11 would be the word totals 
B11:D11 would be the monthly totals 

A13 would be the team name 
A14 thru A22 would be the list of players 
B14 thru D22 would be scores 
A23 would be the word totals 
B23:D23 would be monthly totals

The macro that I have come up with is:

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+q
'
    Range("A1").Select
    Selection.Copy
    Range("J1").Select
    ActiveSheet.Paste Link:=True
    Application.CutCopyMode = False
    Range("B11:D11").Select
    Selection.Copy
    Range("K1:N1").Select
    ActiveSheet.Paste Link:=True
    Application.CutCopyMode = False
    Range("A13").Select
    Selection.Copy
    Range("J2").Select
    ActiveSheet.Paste Link:=True
    Application.CutCopyMode = False
    Range("B23:D23").Select
    Selection.Copy
    Range("K2:N2").Select
    ActiveSheet.Paste Link:=True
End Sub

This works okay but I have over 8,000 lines of text that need to be copied and pasted.  Thanks in advance for your time and patience.  :)

rizvisa1 · Answer

So why there is  a jump between A1 and A13. Are you only copying every 12th row ?

sholly64 · Answer

Thank you for the reply.  Yes, that is what I would like to do.

rizvisa1 · Answer

Try this 
Assumption is that you want to  
process rows in a chunk of 12 
you want to quit if the cell in column A of the first cell of chunk (a1, a13, ...) is blank 

Sub doCopyRange() 

   Dim lRow             As Long 
   lRow = 1 
   Do While (Cells(lRow, 1) <> vbNullString) 
      Application.CutCopyMode = False 
      Cells(lRow, "A").Copy 
      Cells(lRow, "J").Paste Link:=True 
      Application.CutCopyMode = False 
      Range(Cells(lRow + 10, "B"), Cells(lRow, "D")).Copy 
      Range(Cells(lRow, "K"), Cells(lRow, "N")).Paste Link:=True 
      Application.CutCopyMode = False 
      lRow = lRow + 12 
   Loop 
End Sub


Note: 
 I am not sure if this will work 
      Range(Cells(lRow, "K"), Cells(lRow, "N")).Paste Link:=True 
If it does not, try with  
Range(Cells(lRow, "K"), Cells(lRow, "M")).Paste Link:=True

If it still does not work, please upload a sample file with sample data at some file sharing site and post back the link to the file back here

Macro to Copy and Paste

3 responses

Similar discussions

Subscribe To Our Newsletter!