Home |
Search |
Today's Posts |
#1
|
|||
|
|||
Help with COPY code
Hi,
I've put the below code together to aggregate data from a number of workbooks. (The items not explicitly defined are inputs into the sub, collected from a userform.) Problem is: the data copied and pasted from the first source workbook gets deleted when data from the second source workbook is copied and pasted and so on. In otherwords, instead of getting a target file with the data aggregated, only the data from the last source workbook is showing. Is this because I use 'Set range'??? Many thanks in advance for your help. Regards, JvLin Dim SourceFile As Workbook Dim rgFieldNamesRange As Range Dim rgDataRange As Range Dim stTargetFile As String Dim TargetFile As Workbook Dim rgFieldNamesDestination As Range Dim rgDataDestination As Range Dim i As Integer Dim j As Integer Application.DisplayAlerts = False Application.ScreenUpdating = False If Wkb.IsWkbOpen(stFullName) = False Then Set SourceFile = Workbooks.Open(FileName:=stFullName, UpdateLinks:=0) Else Set SourceFile = Workbooks(stFileName) End If If Wkb.IsWkbOpen(stAnalysisFile) = False Then Set TargetFile = Workbooks.Open(FileName:=stAnalysisFile, UpdateLinks:=0) Else stTargetFile = Wkb.GetFileName(stAnalysisFile) Set TargetFile = Workbooks(stTargetFile) End If With SourceFile.Sheets(stSheetName) Set rgFieldNamesRange = .Range(stFieldNamesRange) Set rgDataRange = .Range(stDataRange) End With With TargetFile.Sheets(stSheetName) Set rgFieldNamesDestination = .Range(stFieldNamesDestination) Set rgDataDestination = .Range(stDataDestination) End With If Run = 1 Then rgFieldNamesRange.copy rgFieldNamesDestination.PasteSpecial Transpose:=stTranspose End If rgDataRange.copy If Run = 1 Then rgDataDestination.PasteSpecial Transpose:=stTranspose Else i = rgDataRange.Rows.Count j = rgDataRange.Columns.Count If stBelow = True Then If stTranspose = True Then rgDataDestination.Offset((Run - 1) * j + 1, 0).PasteSpecial Transpose:=stTranspose Else rgDataDestination.Offset((Run - 1) * i + 1, 0).PasteSpecial Transpose:=stTranspose End If Else If stTranspose = True Then rgDataDestination.Offset(0, (Run - 1) * i + 1).PasteSpecial Transpose:=stTranspose Else rgDataDestination.Offset(0, (Run - 1) * j + 1).PasteSpecial Transpose:=stTranspose End If End If End If Application.CutCopyMode = False Workbooks(stFileName).Saved = True Workbooks(stFileName).Close Application.DisplayAlerts = True Application.ScreenUpdating = True |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Opening a file with code without a set file name | Excel Discussion (Misc queries) | |||
Opening a file with code without a set file name | Excel Discussion (Misc queries) | |||
code to Copy cells from the above row. | Excel Worksheet Functions | |||
Command Button VBA code | Excel Discussion (Misc queries) | |||
Zip Code Macro | Excel Worksheet Functions |