loop to copy paste

  • Thread starter Thread starter Norvascom
  • Start date Start date
N

Norvascom

Hi,

I have two worksheets within the same workbook. On the first worksheet
"Sheet1" I have data on column D to S starting on row 7. The number of
row evolves over time. I am trying to create a loop to copy paste data
from "Sheet1" to "Sheet 2". However, on the destination "Sheet2", data
should be reported on only one column starting on cell B2. Each of the
data on the columns of "Sheet1" should go below each other on
"Sheet2".

As a example range D7:D40 in "Sheet1" should be copied on "Sheet2"
B2:B35. Then range E7:E40 in "Sheet1" should be copied on "Sheet2"
B36:B69, etc...

Thanks for your help.
 
Hi,

I have two worksheets within the same workbook. On the first worksheet
"Sheet1" I have data on column D to S starting on row 7. The number of
row evolves over time. I am trying to create a loop to copy paste data
from "Sheet1" to "Sheet 2". However, on the destination "Sheet2", data
should be reported on only one column starting on cell B2. Each of the
data on the columns of "Sheet1" should go below each other on
"Sheet2".

As a example range D7:D40 in "Sheet1" should be copied on "Sheet2"
B2:B35. Then range E7:E40 in "Sheet1" should be copied on "Sheet2"
B36:B69, etc...

Thanks for your help.
Click to expand...
Send your file with a complete explanation and before/after examples
to dguillett1        @gmail.com
 
Send your file with a complete explanation and before/after examples
to dguillett1        @gmail.com
Click to expand...

This assumes you do not know the start row or column of the source
sheet or the length of each column. Be sure to save your file as
an .xls or .xlsM file for macros.
'=============
Option Explicit
Sub CopyColumnsToOneColumnSAS()

Dim ss As Worksheet
Dim ds As Worksheet
Dim fr As Long 'find first row in souce sheet
Dim fc As Long 'find first column
Dim i As Long ' number of times to do it
Dim slr As Long 'find last row for each column
Dim dlr As Long 'find next available row in destination

Set ss = Sheets("sheet1")
Set ds = Sheets("sheet2")
Application.ScreenUpdating = False
ds.Columns(2).Clear
fr = ss.Cells.Find(What:="*").Row + 1 '7 row 7
fc = ss.Cells.Find(What:="*").Column '4 col D
For i = fc To ss.Cells(fr, Columns.Count).End(xlToLeft).Column
slr = ss.Cells(Rows.Count, i).End(xlUp).Row ;row 40
dlr = ds.Cells(Rows.Count, 2).End(xlUp).Row + 1
ss.Cells(fr, i).Resize(slr).Copy ds.Cells(dlr, 2)
Next i
Application.ScreenUpdating = True
End Sub
 
This assumes you do not know the start row or column of the source
sheet or the length of each column. Be sure to save your file as
an .xls or .xlsM file for macros.
'=============
Option Explicit
Sub CopyColumnsToOneColumnSAS()

Dim ss As Worksheet
Dim ds As Worksheet
Dim fr As Long 'find first row in souce sheet
Dim fc As Long 'find first column
Dim i As Long ' number of times to do it
Dim slr As Long 'find last row for each column
Dim dlr As Long 'find next available row in destination

Set ss = Sheets("sheet1")
Set ds = Sheets("sheet2")
Application.ScreenUpdating = False
ds.Columns(2).Clear
fr = ss.Cells.Find(What:="*").Row + 1   '7 row 7
fc = ss.Cells.Find(What:="*").Column   '4 col D
For i = fc To ss.Cells(fr, Columns.Count).End(xlToLeft).Column
slr = ss.Cells(Rows.Count, i).End(xlUp).Row   ;row 40
dlr = ds.Cells(Rows.Count, 2).End(xlUp).Row + 1
ss.Cells(fr, i).Resize(slr).Copy ds.Cells(dlr, 2)
Next i
Application.ScreenUpdating = True
End Sub- Hide quoted text -

- Show quoted text -
Click to expand...

Thanks Don. It works perfectly.
However, what if I want to have it columns specifics (column D to S
only) and starts at a specific row (row 7 in my case).
Indeed, my report will then include titles and additional columns that
I don't want to have copied to "Sheet2".
 
Thanks Don. It works perfectly.
However, what if I want to have it columns specifics (column D to S
only) and starts at a specific row (row 7 in my case).
Indeed, my report will then include titles and additional columns that
I don't want to have copied to "Sheet2".
Click to expand...

I wrote it as if you did NOT know which to use so just change
fr = 7 'ss.Cells.Find(What:="*").Row + 1
fc = 4 'ss.Cells.Find(What:="*").Column
For i = fc To 19 ' ss.Cells(fr, Columns.Count).End(xlToLeft).Column
 
I wrote it as if you did NOT know which to use so just change
fr = 7 'ss.Cells.Find(What:="*").Row + 1
fc = 4 'ss.Cells.Find(What:="*").Column
For i = fc To 19 ' ss.Cells(fr, Columns.Count).End(xlToLeft).Column- Hide quoted text -

- Show quoted text -
Click to expand...

Thanks.
One last question. What should I change if I need to change the
destination on "Sheet2" from cell B2 to C6.
I was able to change the column to C, but I don't know how to change
the row to start at 6. See below what I have:

Sub Copy()
Dim ss As Worksheet
Dim ds As Worksheet
Dim fr As Long 'find first row in souce sheet
Dim fc As Long 'find first column
Dim i As Long ' number of times to do it
Dim slr As Long 'find last row for each column
Dim dlr As Long 'find next available row in destination

Set ss = Sheets("Sheet1")
Set ds = Sheets("Sheet2")
Application.ScreenUpdating = False
ds.Columns(3).Clear
fr = 7 'starting row 7
fc = 4 'starting column 4 (D)
For i = fc To 19 'finishing colum S
slr = ss.Cells(Rows.Count, i).End(xlUp).Row
dlr = ds.Cells(Rows.Count, 3).End(xlUp).Row + 1 '3 corresponds to
column C on destination
ss.Cells(fr, i).Resize(slr).Copy ds.Cells(dlr, 3) '3 corresponds
to column C on destination
Next i
Application.ScreenUpdating = True
End Sub
 
Back
Top