Hi All,
I've put together a code which opens a workbook and copy and pastes data into another workbook. Right now my code only selects a specified sheet to copy from (strName) but what I would like to do is copy data from each sheet in the data workbook. The sheets are named "Array 1, Array 2, Array 3, etc., etc.,. The number of sheets could vary up to 100+. I've copied the code I'm currently using below for reference. Thank you for all your help!
Sub Button6_Click()
Dim strName As String 'name of sheet to get data from
Dim wbThisBook As Workbook 'workbook where the data is to be pasted
Dim wbTargetBook As Workbook 'workbook from where the data is to copied
Dim intFindrowa As Integer
Dim rngFinda As Range
Dim intFindrowb As Integer
Dim rngFindb As Range
FilePath4 = Sheets("Hidden Data").Range("N4")
strName = Sheets("Hidden Data").Range("N5")
'open a workbook
Set wbThisBook = ActiveWorkbook
'clear contents currently in cells
wbThisBook.Worksheets("APP D Wind Data").Range("L6:BI500").Clear
'activate the source book
Set wbTargetBook = Workbooks.Open(FilePath4)
wbTargetBook.Activate
'select the correct map from the drop down list
wbTargetBook.Sheets(strName).Select 'selects sheet to use from workbook
wbTargetBook.Worksheets(strName).Range("D1:G1").Select
Selection.UnMerge
wbTargetBook.Worksheets(strName).Range("D1").Value = "sliding+uplift adjusted"
'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False
'find range of cells to copy the map required
With wbTargetBook.Worksheets(strName).Select
Set rngFinda = wbTargetBook.Worksheets(strName).Range("A:A").Find(What:="Module Index", LookIn:=xlValues)
If Not rngFinda Is Nothing Then
intFindrowa = rngFinda.Row
End If
End With
'Copy ballast required map data from target book
wbTargetBook.Worksheets(strName).Range("A2:V" & intFindrowa - 1).Copy
'Activate main workbook
wbThisBook.Activate
'
'paste the ballast required map data in this book
wbThisBook.Sheets("APP D Wind Data").Range("AI6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbThisBook.Sheets("APP D Wind Data").Range("AI6").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False
'Find range of cells to copy the module index map
With wbTargetBook.Sheets(strName)
Set rngFindb = wbTargetBook.Sheets(strName).Range("B:B").Find(What:="Windzone", LookIn:=xlValues)
If Not rngFindb Is Nothing Then
intFindrowb = rngFindb.Row
End If
End With
'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False
'Copy select data from target book
wbTargetBook.Sheets(strName).Range("A" & intFindrowa + 1 & ":V" & intFindrowb - 2).Copy
'Activate main workbook
wbThisBook.Activate
'paste the data in this book
wbThisBook.Sheets("APP D Wind Data").Range("L6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbThisBook.Sheets("APP D Wind Data").Range("L6").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False
'save the target book
wbTargetBook.Save
'close the workbook
wbTargetBook.Close
'activate the source book again
wbThisBook.Activate
'go back to main input sheet
Sheets("Data Input").Activate
'clear memory
Set wbTargetBook = Nothing
Set wbThisBook = Nothing
Application.ScreenUpdating = True
End Sub
Bookmarks