PDA

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

snb
11-04-2013, 03:46 PM
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

snb
11-05-2013, 03:13 AM
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.