This is my first time so sorry in advance.
I have a file with several sheets, I need to copy from A14 to I14 and then do
Range(Selection, Selection.End(xlDown)).Select
In order to capture all the data from the original range to the bottom, all sheets have different number of rows thats why I need to do that.
Once the data is selected I need to copy and paste in another tab called "Report", and I need to do that for each sheet in the workbook.
Everytime a sheet is paste into the "Report" tab next sheet needs to go in the next avialbale row of the "Report" tab in other words I can not paste above the last information. Is a rolling report.
Don't understand the issue, but some tips:
Find the last row used, using:
Dim LastRow As Long
Dim ws as Worksheet
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Note: column 1 (A) is searched.
Loop through all worksheets using:
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
'Your code goes here
next ws
Take this as base and adjust to your requirement. This program is Untested and may require adjustment for Header Rows. I have commented out Header Rows in program keeping in view you want to start from `Row1`
Sub CopyToReport()
Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Master Worksheet
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets
'Speed things up
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Working in active workbook
Set wrk = ActiveWorkbook
'Create/Reset the Report sheet
If Evaluate("ISREF(Report!A1)") Then
wrk.Sheets("Report").Move After:=Worksheets(Worksheets.Count)
wrk.Sheets("Report").Cells.Clear
Else
wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)).Name = "Report"
End If
Set trg = wrk.Sheets("Report")
'Get column headers from the first worksheet
'Column count first
Set sht = wrk.Worksheets(1)
' colCount = sht.Cells(1, Columns.Count).End(xlToLeft).Column
colCount =9
'Now retrieve headers, no copy&paste needed
'With trg.Cells(1, 1).Resize(1, colCount)
' .Value = sht.Cells(1, 1).Resize(1, colCount).Value
' 'Set font as bold
' .Font.Bold = True
'End With
'We can start loop
For Each sht In wrk.Worksheets
'Execute on every sheet except the Master
If sht.Name <> "Master" Then
'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
'Set rng = sht.Range(sht.Cells(1, 1), sht.Cells(Rows.Count, colCount).End(xlUp))
Set rng = sht.Range("A1:I14")
'Put data into the Master worksheet
trg.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End If
Next sht
'Fit the columns in Master worksheet
trg.Columns.AutoFit
'Screen updating should be activated
Application.ScreenUpdating = True
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.