bananas
06-12-2016, 02:38 AM
Hi all,
I’m new to VBA and need some help with copying dynamic ranges from Sheet1 to Sheet2, in Book2.
After many days of searching on internet and experimenting with code, I still can't get it to work.
I have eight dynamic ranges in six columns in sheet1 (48 ranges in total), to be copied to 48 static cells in sheet2.
Below you can read code I have used so far. This code works great for the first dynamic range (A6:I8), but I'm stuck when I shall start over at second dynamic range (A13:I24) in Col"A", and next occ. of "ABC", to next occ. of "DEF* (Col"A") or (empty cell in col."B","C","D","E" and "I"), and so on down to the eighth dynamic range (A106:I112).
I have attached Workbook "Book2" so it will be easier to understand the problem.
Option Explicit
Sub Module1()
Dim foundA As Range, _
foundB As Range
Dim newSht As Worksheet
Application.ScreenUpdating = False
On Error GoTo Terminate
With Sheets("Sheet1").Columns(1)
Set foundA = .Find("ABC")
Set foundB = .Find("DEF*", After:=foundA, SearchDirection:=xlNext)
End With
Range(foundA(2), foundB(0)).Copy
Set newSht = Sheets("Sheet2")
newSht.Range("A2").PasteSpecial
With Sheets("Sheet1").Columns(2)
Set foundA = .Find("GHI")
Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext)
End With
Range(foundA(2), foundB(0)).Copy
Set newSht = Sheets("Sheet2")
newSht.Range("C2").PasteSpecial
With Sheets("Sheet1").Columns(3)
Set foundA = .Find("JKL")
Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext)
End With
Range(foundA(2), foundB(0)).Copy
Set newSht = Sheets("Sheet2")
newSht.Range("F2").PasteSpecial
With Sheets("Sheet1").Columns(4)
Set foundA = .Find("MNO")
Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext)
End With
Range(foundA(2), foundB(0)).Copy
Set newSht = Sheets("Sheet2")
newSht.Range("G2").PasteSpecial
With Sheets("Sheet1").Columns(5)
Set foundA = .Find("PQR")
Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext)
End With
Range(foundA(2), foundB(0)).Copy
Set newSht = Sheets("Sheet2")
newSht.Range("I2").PasteSpecial
With Sheets("Sheet1").Columns(9)
Set foundA = .Find("YZ2")
Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext)
End With
Range(foundA(2), foundB(0)).Copy
Set newSht = Sheets("Sheet2")
newSht.Range("R2").PasteSpecial
Exit Sub
Terminate:
MsgBox "Error in Code"
End
Application.ScreenUpdating = True
End Sub
Any help will be greatly appreciated.
Thanks!
I’m new to VBA and need some help with copying dynamic ranges from Sheet1 to Sheet2, in Book2.
After many days of searching on internet and experimenting with code, I still can't get it to work.
I have eight dynamic ranges in six columns in sheet1 (48 ranges in total), to be copied to 48 static cells in sheet2.
Below you can read code I have used so far. This code works great for the first dynamic range (A6:I8), but I'm stuck when I shall start over at second dynamic range (A13:I24) in Col"A", and next occ. of "ABC", to next occ. of "DEF* (Col"A") or (empty cell in col."B","C","D","E" and "I"), and so on down to the eighth dynamic range (A106:I112).
I have attached Workbook "Book2" so it will be easier to understand the problem.
Option Explicit
Sub Module1()
Dim foundA As Range, _
foundB As Range
Dim newSht As Worksheet
Application.ScreenUpdating = False
On Error GoTo Terminate
With Sheets("Sheet1").Columns(1)
Set foundA = .Find("ABC")
Set foundB = .Find("DEF*", After:=foundA, SearchDirection:=xlNext)
End With
Range(foundA(2), foundB(0)).Copy
Set newSht = Sheets("Sheet2")
newSht.Range("A2").PasteSpecial
With Sheets("Sheet1").Columns(2)
Set foundA = .Find("GHI")
Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext)
End With
Range(foundA(2), foundB(0)).Copy
Set newSht = Sheets("Sheet2")
newSht.Range("C2").PasteSpecial
With Sheets("Sheet1").Columns(3)
Set foundA = .Find("JKL")
Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext)
End With
Range(foundA(2), foundB(0)).Copy
Set newSht = Sheets("Sheet2")
newSht.Range("F2").PasteSpecial
With Sheets("Sheet1").Columns(4)
Set foundA = .Find("MNO")
Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext)
End With
Range(foundA(2), foundB(0)).Copy
Set newSht = Sheets("Sheet2")
newSht.Range("G2").PasteSpecial
With Sheets("Sheet1").Columns(5)
Set foundA = .Find("PQR")
Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext)
End With
Range(foundA(2), foundB(0)).Copy
Set newSht = Sheets("Sheet2")
newSht.Range("I2").PasteSpecial
With Sheets("Sheet1").Columns(9)
Set foundA = .Find("YZ2")
Set foundB = .Find("", After:=foundA, SearchDirection:=xlNext)
End With
Range(foundA(2), foundB(0)).Copy
Set newSht = Sheets("Sheet2")
newSht.Range("R2").PasteSpecial
Exit Sub
Terminate:
MsgBox "Error in Code"
End
Application.ScreenUpdating = True
End Sub
Any help will be greatly appreciated.
Thanks!