VBABEGINER
Well-known Member
- Joined
- Jun 15, 2011
- Messages
- 1,284
- Office Version
- 365
- Platform
- Windows
Hi All,
Im facing copy paste problem in red line. Can anyone suggest, the correction here..
Im facing copy paste problem in red line. Can anyone suggest, the correction here..
Code:
Sub fnCombine()
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combine"
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
If ws.Name = "Atlantic" Or ws.Name = "South" Or ws.Name = "Midwest" Or ws.Name = "Northeast" Or ws.Name = "CA" Or ws.Name = "West" Or ws.Name = "SELECT" Then
ws.Activate
Cells(1, 1).Select
i = Range("A1:A5000").Find("Monthly", Range("A1"), xlValues, xlWhole, xlByColumns, xlNext).Row
x = i + 3
LC = Cells(3, Columns.Count).End(xlToLeft).Column
bLR = Range(Range("B5"), Range("B5").End(xlDown)).Rows.Count
If ws.Name = "Atlantic" Then
ws.Range(Cells(x, 1), Cells(x + 1, LC)).Select
Selection.Copy
Worksheets("Combine").Range("A1").PasteSpecial xlPasteValues
Worksheets("Combine").Range("A1").PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Worksheets("Combine").Select
j = Range("A" & Rows.Count).End(xlUp).Row
ws.Activate
ws.Range(Cells(x + 2, 1), Cells(x + 1 + bLR, LC)).Select
Selection.Copy
[COLOR=#ff0000] Worksheets("Combine").Range("A" & j).Select[/COLOR]
ActiveSheet.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Else
End If
End If
Next ws
End Sub
