#1   Report Post  
JVLin
 
Posts: n/a
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Opening a file with code without a set file name jenkinspat Excel Discussion (Misc queries) 1 March 4th 05 10:50 AM
Opening a file with code without a set file name jenkinspat Excel Discussion (Misc queries) 1 March 3rd 05 03:40 PM
code to Copy cells from the above row. Fernando Excel Worksheet Functions 1 January 27th 05 08:14 PM
Command Button VBA code Dave Peterson Excel Discussion (Misc queries) 2 January 25th 05 11:28 PM
Zip Code Macro Ken Wright Excel Worksheet Functions 0 December 9th 04 07:55 AM


All times are GMT +1. The time now is 11:30 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"