View Full Version : [SOLVED:] Copy range from sheets with similar name.
streub
11-04-2013, 02:27 PM
I have twelve worksheets named "Jan.Graphs, Feb.Graphs, etc." Each worksheet has a columnar range of budget figures that I need to copy then paste transposed to first empty row of sheet 3.
Here is what is not working:
Private Sub budfnd()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
If ws.Name Like "*_Graphs" Then
ws.Range("b3:b33").Select
Selection.Copy
Worksheets("sheet3").Cells(Rows.Count, 1).End(xlUp).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next
End Sub
Sub M_snb()
For Each ws In ThisWorkbook.Sheets
If right(ws.Name,6)="Graphs" Then sheets("sheet3").Cells(Rows.Count, 1).End(xlUp).offset(1).resize(,30)=application.transpose(ws.Range("b3:b33").value)
Next
End Sub
NB Avoid 'select' and 'activate' in VBA
streub
11-04-2013, 04:10 PM
Unbelievable! I was scanning the web for solutions and Whamo! There you are. Omnipresent as always.
While I was hacking I determined some additional code is required prior to copy.
Range("a1").UnMerge
Range("a1").ClearContents
Range("b1").Value = "01"
Range("b2").Value = "13"
Range("b1:b33").ClearFormats
Wher should this be incorporated?
Thank you.
Sub M_snb()
For Each ws In ThisWorkbook.Sheets
If right(ws.Name,6)="Graphs" Then sheets("sheet3").Cells(Rows.Count, 1).End(xlUp).offset(1).resize(,30)=application.transpose(ws.Range("b3:b33").value)
Next
End Sub
NB Avoid 'select' and 'activate' in VBA
Sub M_snb()
For Each ws In ThisWorkbook.Sheets
with ws
If right(.Name,6)="Graphs" Then
.Range("a1").UnMerge
.Range("a1").ClearContents
.Range("b1:b2").Value = application.transpose(array("01","13"))
.Range("b1:b33").ClearFormats
sheets("sheet3").Cells(Rows.Count, 1).End(xlUp).offset(1).resize(,30)=application.transpose(.Range("b3:b33").value)
end if
end with
Next
End Sub
streub
11-05-2013, 05:22 AM
Perfect and thank you very much.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.